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 const PetscScalar *vals; 122 PetscScalar v; 123 124 ierr = MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr); 125 ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr); 126 ierr = MatDenseGetArrayRead(GEd,&vals);CHKERRQ(ierr); 127 /* v = PetscAbsScalar(vals[0]) */; 128 v = 1.; 129 cvals[0] = vals[0]/v; 130 cvals[1] = vals[1]/v; 131 ierr = MatDenseRestoreArrayRead(GEd,&vals);CHKERRQ(ierr); 132 ierr = MatScale(*GKins,1./v);CHKERRQ(ierr); 133 #if defined(PRINT_GDET) 134 { 135 PetscViewer viewer; 136 char filename[256]; 137 sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++); 138 ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr); 139 ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr); 140 ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr); 141 ierr = MatView(GEc,viewer);CHKERRQ(ierr); 142 ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr); 143 ierr = MatView(*GKins,viewer);CHKERRQ(ierr); 144 ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr); 145 ierr = MatView(GEd,viewer);CHKERRQ(ierr); 146 ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); 147 } 148 #endif 149 ierr = MatDestroy(&GEd);CHKERRQ(ierr); 150 ierr = MatDestroy(&GEc);CHKERRQ(ierr); 151 } 152 153 PetscFunctionReturn(0); 154 } 155 156 PetscErrorCode PCBDDCNedelecSupport(PC pc) 157 { 158 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 159 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 160 Mat G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit; 161 Vec tvec; 162 PetscSF sfv; 163 ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g; 164 MPI_Comm comm; 165 IS lned,primals,allprimals,nedfieldlocal; 166 IS *eedges,*extrows,*extcols,*alleedges; 167 PetscBT btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter; 168 PetscScalar *vals,*work; 169 PetscReal *rwork; 170 const PetscInt *idxs,*ii,*jj,*iit,*jjt; 171 PetscInt ne,nv,Lv,order,n,field; 172 PetscInt n_neigh,*neigh,*n_shared,**shared; 173 PetscInt i,j,extmem,cum,maxsize,nee; 174 PetscInt *extrow,*extrowcum,*marks,*vmarks,*gidxs; 175 PetscInt *sfvleaves,*sfvroots; 176 PetscInt *corners,*cedges; 177 PetscInt *ecount,**eneighs,*vcount,**vneighs; 178 #if defined(PETSC_USE_DEBUG) 179 PetscInt *emarks; 180 #endif 181 PetscBool print,eerr,done,lrc[2],conforming,global,singular,setprimal; 182 PetscErrorCode ierr; 183 184 PetscFunctionBegin; 185 /* If the discrete gradient is defined for a subset of dofs and global is true, 186 it assumes G is given in global ordering for all the dofs. 187 Otherwise, the ordering is global for the Nedelec field */ 188 order = pcbddc->nedorder; 189 conforming = pcbddc->conforming; 190 field = pcbddc->nedfield; 191 global = pcbddc->nedglobal; 192 setprimal = PETSC_FALSE; 193 print = PETSC_FALSE; 194 singular = PETSC_FALSE; 195 196 /* Command line customization */ 197 ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr); 198 ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr); 199 ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr); 200 ierr = PetscOptionsInt("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr); 201 /* print debug info TODO: to be removed */ 202 ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr); 203 ierr = PetscOptionsEnd();CHKERRQ(ierr); 204 205 /* Return if there are no edges in the decomposition and the problem is not singular */ 206 ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr); 207 ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr); 208 ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr); 209 if (!singular) { 210 ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr); 211 lrc[0] = PETSC_FALSE; 212 for (i=0;i<n;i++) { 213 if (PetscRealPart(vals[i]) > 2.) { 214 lrc[0] = PETSC_TRUE; 215 break; 216 } 217 } 218 ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr); 219 ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr); 220 if (!lrc[1]) PetscFunctionReturn(0); 221 } 222 223 /* Get Nedelec field */ 224 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); 225 if (pcbddc->n_ISForDofsLocal && field >= 0) { 226 ierr = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr); 227 nedfieldlocal = pcbddc->ISForDofsLocal[field]; 228 ierr = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr); 229 } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) { 230 ne = n; 231 nedfieldlocal = NULL; 232 global = PETSC_TRUE; 233 } else if (field == PETSC_DECIDE) { 234 PetscInt rst,ren,*idx; 235 236 ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr); 237 ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr); 238 ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr); 239 for (i=rst;i<ren;i++) { 240 PetscInt nc; 241 242 ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr); 243 if (nc > 1) matis->sf_rootdata[i-rst] = 1; 244 ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr); 245 } 246 ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr); 247 ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr); 248 ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr); 249 for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i; 250 ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr); 251 } else { 252 SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified"); 253 } 254 255 /* Sanity checks */ 256 if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time"); 257 if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis"); 258 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); 259 260 /* Just set primal dofs and return */ 261 if (setprimal) { 262 IS enedfieldlocal; 263 PetscInt *eidxs; 264 265 ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr); 266 ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr); 267 if (nedfieldlocal) { 268 ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr); 269 for (i=0,cum=0;i<ne;i++) { 270 if (PetscRealPart(vals[idxs[i]]) > 2.) { 271 eidxs[cum++] = idxs[i]; 272 } 273 } 274 ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr); 275 } else { 276 for (i=0,cum=0;i<ne;i++) { 277 if (PetscRealPart(vals[i]) > 2.) { 278 eidxs[cum++] = i; 279 } 280 } 281 } 282 ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr); 283 ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr); 284 ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr); 285 ierr = PetscFree(eidxs);CHKERRQ(ierr); 286 ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr); 287 ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr); 288 PetscFunctionReturn(0); 289 } 290 291 /* Compute some l2g maps */ 292 if (nedfieldlocal) { 293 IS is; 294 295 /* need to map from the local Nedelec field to local numbering */ 296 ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr); 297 /* need to map from the local Nedelec field to global numbering for the whole dofs*/ 298 ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr); 299 ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr); 300 /* need to map from the local Nedelec field to global numbering (for Nedelec only) */ 301 if (global) { 302 ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr); 303 el2g = al2g; 304 } else { 305 IS gis; 306 307 ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr); 308 ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr); 309 ierr = ISDestroy(&gis);CHKERRQ(ierr); 310 } 311 ierr = ISDestroy(&is);CHKERRQ(ierr); 312 } else { 313 /* restore default */ 314 pcbddc->nedfield = -1; 315 /* one ref for the destruction of al2g, one for el2g */ 316 ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr); 317 ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr); 318 el2g = al2g; 319 fl2g = NULL; 320 } 321 322 /* Start communication to drop connections for interior edges (for cc analysis only) */ 323 ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr); 324 ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr); 325 if (nedfieldlocal) { 326 ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr); 327 for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1; 328 ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr); 329 } else { 330 for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1; 331 } 332 ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr); 333 ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr); 334 335 if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */ 336 ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr); 337 ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr); 338 if (global) { 339 PetscInt rst; 340 341 ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr); 342 for (i=0,cum=0;i<pc->pmat->rmap->n;i++) { 343 if (matis->sf_rootdata[i] < 2) { 344 matis->sf_rootdata[cum++] = i + rst; 345 } 346 } 347 ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr); 348 ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr); 349 } else { 350 PetscInt *tbz; 351 352 ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr); 353 ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr); 354 ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr); 355 ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr); 356 for (i=0,cum=0;i<ne;i++) 357 if (matis->sf_leafdata[idxs[i]] == 1) 358 tbz[cum++] = i; 359 ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr); 360 ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr); 361 ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr); 362 ierr = PetscFree(tbz);CHKERRQ(ierr); 363 } 364 } else { /* we need the entire G to infer the nullspace */ 365 ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr); 366 G = pcbddc->discretegradient; 367 } 368 369 /* Extract subdomain relevant rows of G */ 370 ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr); 371 ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr); 372 ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr); 373 ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr); 374 ierr = ISDestroy(&lned);CHKERRQ(ierr); 375 ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr); 376 ierr = MatDestroy(&lGall);CHKERRQ(ierr); 377 ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr); 378 379 /* SF for nodal dofs communications */ 380 ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr); 381 ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr); 382 ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr); 383 ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr); 384 ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr); 385 ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr); 386 ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr); 387 ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr); 388 i = singular ? 2 : 1; 389 ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr); 390 391 /* Destroy temporary G created in MATIS format and modified G */ 392 ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr); 393 ierr = MatDestroy(&lGis);CHKERRQ(ierr); 394 ierr = MatDestroy(&G);CHKERRQ(ierr); 395 396 if (print) { 397 ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr); 398 ierr = MatView(lG,NULL);CHKERRQ(ierr); 399 } 400 401 /* Save lG for values insertion in change of basis */ 402 ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr); 403 404 /* Analyze the edge-nodes connections (duplicate lG) */ 405 ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr); 406 ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr); 407 ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr); 408 ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr); 409 ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr); 410 ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr); 411 ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr); 412 /* need to import the boundary specification to ensure the 413 proper detection of coarse edges' endpoints */ 414 if (pcbddc->DirichletBoundariesLocal) { 415 IS is; 416 417 if (fl2g) { 418 ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr); 419 } else { 420 is = pcbddc->DirichletBoundariesLocal; 421 } 422 ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr); 423 ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr); 424 for (i=0;i<cum;i++) { 425 if (idxs[i] >= 0) { 426 ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr); 427 ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr); 428 } 429 } 430 ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr); 431 if (fl2g) { 432 ierr = ISDestroy(&is);CHKERRQ(ierr); 433 } 434 } 435 if (pcbddc->NeumannBoundariesLocal) { 436 IS is; 437 438 if (fl2g) { 439 ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr); 440 } else { 441 is = pcbddc->NeumannBoundariesLocal; 442 } 443 ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr); 444 ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr); 445 for (i=0;i<cum;i++) { 446 if (idxs[i] >= 0) { 447 ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr); 448 } 449 } 450 ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr); 451 if (fl2g) { 452 ierr = ISDestroy(&is);CHKERRQ(ierr); 453 } 454 } 455 456 /* Count neighs per dof */ 457 ierr = ISLocalToGlobalMappingGetNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr); 458 ierr = ISLocalToGlobalMappingGetNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr); 459 460 /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs 461 for proper detection of coarse edges' endpoints */ 462 ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr); 463 for (i=0;i<ne;i++) { 464 if ((ecount[i] > 2 && !PetscBTLookup(btbd,i)) || (ecount[i] == 2 && PetscBTLookup(btb,i))) { 465 ierr = PetscBTSet(btee,i);CHKERRQ(ierr); 466 } 467 } 468 ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr); 469 if (!conforming) { 470 ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr); 471 ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr); 472 } 473 ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 474 ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr); 475 cum = 0; 476 for (i=0;i<ne;i++) { 477 /* eliminate rows corresponding to edge dofs belonging to coarse faces */ 478 if (!PetscBTLookup(btee,i)) { 479 marks[cum++] = i; 480 continue; 481 } 482 /* set badly connected edge dofs as primal */ 483 if (!conforming) { 484 if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */ 485 marks[cum++] = i; 486 ierr = PetscBTSet(bte,i);CHKERRQ(ierr); 487 for (j=ii[i];j<ii[i+1];j++) { 488 ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr); 489 } 490 } else { 491 /* every edge dofs should be connected trough a certain number of nodal dofs 492 to other edge dofs belonging to coarse edges 493 - at most 2 endpoints 494 - order-1 interior nodal dofs 495 - no undefined nodal dofs (nconn < order) 496 */ 497 PetscInt ends = 0,ints = 0, undef = 0; 498 for (j=ii[i];j<ii[i+1];j++) { 499 PetscInt v = jj[j],k; 500 PetscInt nconn = iit[v+1]-iit[v]; 501 for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--; 502 if (nconn > order) ends++; 503 else if (nconn == order) ints++; 504 else undef++; 505 } 506 if (undef || ends > 2 || ints != order -1) { 507 marks[cum++] = i; 508 ierr = PetscBTSet(bte,i);CHKERRQ(ierr); 509 for (j=ii[i];j<ii[i+1];j++) { 510 ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr); 511 } 512 } 513 } 514 } 515 /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */ 516 if (!order && ii[i+1] != ii[i]) { 517 PetscScalar val = 1./(ii[i+1]-ii[i]-1); 518 for (j=ii[i];j<ii[i+1];j++) vals[j] = val; 519 } 520 } 521 ierr = PetscBTDestroy(&btee);CHKERRQ(ierr); 522 ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr); 523 ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 524 if (!conforming) { 525 ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr); 526 ierr = MatDestroy(&lGt);CHKERRQ(ierr); 527 } 528 ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr); 529 530 /* identify splitpoints and corner candidates */ 531 ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr); 532 if (print) { 533 ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr); 534 ierr = MatView(lGe,NULL);CHKERRQ(ierr); 535 ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr); 536 ierr = MatView(lGt,NULL);CHKERRQ(ierr); 537 } 538 ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 539 ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr); 540 for (i=0;i<nv;i++) { 541 PetscInt ord = order, test = ii[i+1]-ii[i], vc = vcount[i]; 542 PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE; 543 if (!order) { /* variable order */ 544 PetscReal vorder = 0.; 545 546 for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]); 547 test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON); 548 if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%D)",vorder,test); 549 ord = 1; 550 } 551 #if defined(PETSC_USE_DEBUG) 552 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); 553 #endif 554 for (j=ii[i];j<ii[i+1] && sneighs;j++) { 555 if (PetscBTLookup(btbd,jj[j])) { 556 bdir = PETSC_TRUE; 557 break; 558 } 559 if (vc != ecount[jj[j]]) { 560 sneighs = PETSC_FALSE; 561 } else { 562 PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]]; 563 for (k=0;k<vc;k++) { 564 if (vn[k] != en[k]) { 565 sneighs = PETSC_FALSE; 566 break; 567 } 568 } 569 } 570 } 571 if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */ 572 if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %D (%D %D %D)\n",i,!sneighs,test >= 3*ord,bdir); 573 ierr = PetscBTSet(btv,i);CHKERRQ(ierr); 574 } else if (test == ord) { 575 if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) { 576 if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %D\n",i); 577 ierr = PetscBTSet(btv,i);CHKERRQ(ierr); 578 } else { 579 if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %D\n",i); 580 ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr); 581 } 582 } 583 } 584 ierr = ISLocalToGlobalMappingRestoreNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr); 585 ierr = ISLocalToGlobalMappingRestoreNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr); 586 ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr); 587 588 /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */ 589 if (order != 1) { 590 if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n"); 591 ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr); 592 for (i=0;i<nv;i++) { 593 if (PetscBTLookup(btvcand,i)) { 594 PetscBool found = PETSC_FALSE; 595 for (j=ii[i];j<ii[i+1] && !found;j++) { 596 PetscInt k,e = jj[j]; 597 if (PetscBTLookup(bte,e)) continue; 598 for (k=iit[e];k<iit[e+1];k++) { 599 PetscInt v = jjt[k]; 600 if (v != i && PetscBTLookup(btvcand,v)) { 601 found = PETSC_TRUE; 602 break; 603 } 604 } 605 } 606 if (!found) { 607 if (print) PetscPrintf(PETSC_COMM_SELF," CANDIDATE %D CLEARED\n",i); 608 ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr); 609 } else { 610 if (print) PetscPrintf(PETSC_COMM_SELF," CANDIDATE %D ACCEPTED\n",i); 611 } 612 } 613 } 614 ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr); 615 } 616 ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr); 617 ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 618 ierr = MatDestroy(&lGe);CHKERRQ(ierr); 619 620 /* Get the local G^T explicitly */ 621 ierr = MatDestroy(&lGt);CHKERRQ(ierr); 622 ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr); 623 ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr); 624 625 /* Mark interior nodal dofs */ 626 ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr); 627 ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr); 628 for (i=1;i<n_neigh;i++) { 629 for (j=0;j<n_shared[i];j++) { 630 ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr); 631 } 632 } 633 ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr); 634 635 /* communicate corners and splitpoints */ 636 ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr); 637 ierr = PetscMemzero(sfvleaves,nv*sizeof(PetscInt));CHKERRQ(ierr); 638 ierr = PetscMemzero(sfvroots,Lv*sizeof(PetscInt));CHKERRQ(ierr); 639 for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1; 640 641 if (print) { 642 IS tbz; 643 644 cum = 0; 645 for (i=0;i<nv;i++) 646 if (sfvleaves[i]) 647 vmarks[cum++] = i; 648 649 ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr); 650 ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr); 651 ierr = ISView(tbz,NULL);CHKERRQ(ierr); 652 ierr = ISDestroy(&tbz);CHKERRQ(ierr); 653 } 654 655 ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr); 656 ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr); 657 ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr); 658 ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr); 659 660 /* Zero rows of lGt corresponding to identified corners 661 and interior nodal dofs */ 662 cum = 0; 663 for (i=0;i<nv;i++) { 664 if (sfvleaves[i]) { 665 vmarks[cum++] = i; 666 ierr = PetscBTSet(btv,i);CHKERRQ(ierr); 667 } 668 if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i; 669 } 670 ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr); 671 if (print) { 672 IS tbz; 673 674 ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr); 675 ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr); 676 ierr = ISView(tbz,NULL);CHKERRQ(ierr); 677 ierr = ISDestroy(&tbz);CHKERRQ(ierr); 678 } 679 ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr); 680 ierr = PetscFree(vmarks);CHKERRQ(ierr); 681 ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr); 682 ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr); 683 684 /* Recompute G */ 685 ierr = MatDestroy(&lG);CHKERRQ(ierr); 686 ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr); 687 if (print) { 688 ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr); 689 ierr = MatView(lG,NULL);CHKERRQ(ierr); 690 ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr); 691 ierr = MatView(lGt,NULL);CHKERRQ(ierr); 692 } 693 694 /* Get primal dofs (if any) */ 695 cum = 0; 696 for (i=0;i<ne;i++) { 697 if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i; 698 } 699 if (fl2g) { 700 ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr); 701 } 702 ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr); 703 if (print) { 704 ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr); 705 ierr = ISView(primals,NULL);CHKERRQ(ierr); 706 } 707 ierr = PetscBTDestroy(&bte);CHKERRQ(ierr); 708 /* TODO: what if the user passed in some of them ? */ 709 ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr); 710 ierr = ISDestroy(&primals);CHKERRQ(ierr); 711 712 /* Compute edge connectivity */ 713 ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr); 714 ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr); 715 ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 716 if (fl2g) { 717 PetscBT btf; 718 PetscInt *iia,*jja,*iiu,*jju; 719 PetscBool rest = PETSC_FALSE,free = PETSC_FALSE; 720 721 /* create CSR for all local dofs */ 722 ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr); 723 if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */ 724 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); 725 iiu = pcbddc->mat_graph->xadj; 726 jju = pcbddc->mat_graph->adjncy; 727 } else if (pcbddc->use_local_adj) { 728 rest = PETSC_TRUE; 729 ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr); 730 } else { 731 free = PETSC_TRUE; 732 ierr = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr); 733 iiu[0] = 0; 734 for (i=0;i<n;i++) { 735 iiu[i+1] = i+1; 736 jju[i] = -1; 737 } 738 } 739 740 /* import sizes of CSR */ 741 iia[0] = 0; 742 for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i]; 743 744 /* overwrite entries corresponding to the Nedelec field */ 745 ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr); 746 ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr); 747 for (i=0;i<ne;i++) { 748 ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr); 749 iia[idxs[i]+1] = ii[i+1]-ii[i]; 750 } 751 752 /* iia in CSR */ 753 for (i=0;i<n;i++) iia[i+1] += iia[i]; 754 755 /* jja in CSR */ 756 ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr); 757 for (i=0;i<n;i++) 758 if (!PetscBTLookup(btf,i)) 759 for (j=0;j<iiu[i+1]-iiu[i];j++) 760 jja[iia[i]+j] = jju[iiu[i]+j]; 761 762 /* map edge dofs connectivity */ 763 if (jj) { 764 ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr); 765 for (i=0;i<ne;i++) { 766 PetscInt e = idxs[i]; 767 for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j]; 768 } 769 } 770 ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr); 771 ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr); 772 if (rest) { 773 ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr); 774 } 775 if (free) { 776 ierr = PetscFree2(iiu,jju);CHKERRQ(ierr); 777 } 778 ierr = PetscBTDestroy(&btf);CHKERRQ(ierr); 779 } else { 780 ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr); 781 } 782 783 /* Analyze interface for edge dofs */ 784 ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr); 785 pcbddc->mat_graph->twodim = PETSC_FALSE; 786 787 /* Get coarse edges in the edge space */ 788 ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr); 789 ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 790 791 if (fl2g) { 792 ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr); 793 ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr); 794 for (i=0;i<nee;i++) { 795 ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr); 796 } 797 } else { 798 eedges = alleedges; 799 primals = allprimals; 800 } 801 802 /* Mark fine edge dofs with their coarse edge id */ 803 ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr); 804 ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr); 805 ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr); 806 for (i=0;i<cum;i++) marks[idxs[i]] = nee+1; 807 ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr); 808 if (print) { 809 ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr); 810 ierr = ISView(primals,NULL);CHKERRQ(ierr); 811 } 812 813 maxsize = 0; 814 for (i=0;i<nee;i++) { 815 PetscInt size,mark = i+1; 816 817 ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr); 818 ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr); 819 for (j=0;j<size;j++) marks[idxs[j]] = mark; 820 ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr); 821 maxsize = PetscMax(maxsize,size); 822 } 823 824 /* Find coarse edge endpoints */ 825 ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 826 ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr); 827 for (i=0;i<nee;i++) { 828 PetscInt mark = i+1,size; 829 830 ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr); 831 if (!size && nedfieldlocal) continue; 832 if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i); 833 ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr); 834 if (print) { 835 ierr = PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %D\n",i);CHKERRQ(ierr); 836 ierr = ISView(eedges[i],NULL);CHKERRQ(ierr); 837 } 838 for (j=0;j<size;j++) { 839 PetscInt k, ee = idxs[j]; 840 if (print) PetscPrintf(PETSC_COMM_SELF," idx %D\n",ee); 841 for (k=ii[ee];k<ii[ee+1];k++) { 842 if (print) PetscPrintf(PETSC_COMM_SELF," inspect %D\n",jj[k]); 843 if (PetscBTLookup(btv,jj[k])) { 844 if (print) PetscPrintf(PETSC_COMM_SELF," corner found (already set) %D\n",jj[k]); 845 } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */ 846 PetscInt k2; 847 PetscBool corner = PETSC_FALSE; 848 for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) { 849 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])); 850 /* it's a corner if either is connected with an edge dof belonging to a different cc or 851 if the edge dof lie on the natural part of the boundary */ 852 if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) { 853 corner = PETSC_TRUE; 854 break; 855 } 856 } 857 if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */ 858 if (print) PetscPrintf(PETSC_COMM_SELF," corner found %D\n",jj[k]); 859 ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr); 860 } else { 861 if (print) PetscPrintf(PETSC_COMM_SELF," no corners found\n"); 862 } 863 } 864 } 865 } 866 ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr); 867 } 868 ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr); 869 ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 870 ierr = PetscBTDestroy(&btb);CHKERRQ(ierr); 871 872 /* Reset marked primal dofs */ 873 ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr); 874 ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr); 875 for (i=0;i<cum;i++) marks[idxs[i]] = 0; 876 ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr); 877 878 /* Now use the initial lG */ 879 ierr = MatDestroy(&lG);CHKERRQ(ierr); 880 ierr = MatDestroy(&lGt);CHKERRQ(ierr); 881 lG = lGinit; 882 ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr); 883 884 /* Compute extended cols indices */ 885 ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr); 886 ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr); 887 ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 888 ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr); 889 i *= maxsize; 890 ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr); 891 ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr); 892 eerr = PETSC_FALSE; 893 for (i=0;i<nee;i++) { 894 PetscInt size,found = 0; 895 896 cum = 0; 897 ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr); 898 if (!size && nedfieldlocal) continue; 899 if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i); 900 ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr); 901 ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr); 902 for (j=0;j<size;j++) { 903 PetscInt k,ee = idxs[j]; 904 for (k=ii[ee];k<ii[ee+1];k++) { 905 PetscInt vv = jj[k]; 906 if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv; 907 else if (!PetscBTLookupSet(btvc,vv)) found++; 908 } 909 } 910 ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr); 911 ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr); 912 ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr); 913 ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr); 914 ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr); 915 /* it may happen that endpoints are not defined at this point 916 if it is the case, mark this edge for a second pass */ 917 if (cum != size -1 || found != 2) { 918 ierr = PetscBTSet(bter,i);CHKERRQ(ierr); 919 if (print) { 920 ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr); 921 ierr = ISView(eedges[i],NULL);CHKERRQ(ierr); 922 ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr); 923 ierr = ISView(extcols[i],NULL);CHKERRQ(ierr); 924 } 925 eerr = PETSC_TRUE; 926 } 927 } 928 /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */ 929 ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr); 930 if (done) { 931 PetscInt *newprimals; 932 933 ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr); 934 ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr); 935 ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr); 936 ierr = PetscMemcpy(newprimals,idxs,cum*sizeof(PetscInt));CHKERRQ(ierr); 937 ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr); 938 ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr); 939 if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %D)\n",eerr); 940 for (i=0;i<nee;i++) { 941 PetscBool has_candidates = PETSC_FALSE; 942 if (PetscBTLookup(bter,i)) { 943 PetscInt size,mark = i+1; 944 945 ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr); 946 ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr); 947 /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */ 948 for (j=0;j<size;j++) { 949 PetscInt k,ee = idxs[j]; 950 if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %D [%D %D)\n",ee,ii[ee],ii[ee+1]); 951 for (k=ii[ee];k<ii[ee+1];k++) { 952 /* set all candidates located on the edge as corners */ 953 if (PetscBTLookup(btvcand,jj[k])) { 954 PetscInt k2,vv = jj[k]; 955 has_candidates = PETSC_TRUE; 956 if (print) PetscPrintf(PETSC_COMM_SELF," Candidate set to vertex %D\n",vv); 957 ierr = PetscBTSet(btv,vv);CHKERRQ(ierr); 958 /* set all edge dofs connected to candidate as primals */ 959 for (k2=iit[vv];k2<iit[vv+1];k2++) { 960 if (marks[jjt[k2]] == mark) { 961 PetscInt k3,ee2 = jjt[k2]; 962 if (print) PetscPrintf(PETSC_COMM_SELF," Connected edge dof set to primal %D\n",ee2); 963 newprimals[cum++] = ee2; 964 /* finally set the new corners */ 965 for (k3=ii[ee2];k3<ii[ee2+1];k3++) { 966 if (print) PetscPrintf(PETSC_COMM_SELF," Connected nodal dof set to vertex %D\n",jj[k3]); 967 ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr); 968 } 969 } 970 } 971 } else { 972 if (print) PetscPrintf(PETSC_COMM_SELF," Not a candidate vertex %D\n",jj[k]); 973 } 974 } 975 } 976 if (!has_candidates) { /* circular edge */ 977 PetscInt k, ee = idxs[0],*tmarks; 978 979 ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr); 980 if (print) PetscPrintf(PETSC_COMM_SELF," Circular edge %D\n",i); 981 for (k=ii[ee];k<ii[ee+1];k++) { 982 PetscInt k2; 983 if (print) PetscPrintf(PETSC_COMM_SELF," Set to corner %D\n",jj[k]); 984 ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr); 985 for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++; 986 } 987 for (j=0;j<size;j++) { 988 if (tmarks[idxs[j]] > 1) { 989 if (print) PetscPrintf(PETSC_COMM_SELF," Edge dof set to primal %D\n",idxs[j]); 990 newprimals[cum++] = idxs[j]; 991 } 992 } 993 ierr = PetscFree(tmarks);CHKERRQ(ierr); 994 } 995 ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr); 996 } 997 ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr); 998 } 999 ierr = PetscFree(extcols);CHKERRQ(ierr); 1000 ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr); 1001 ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr); 1002 if (fl2g) { 1003 ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr); 1004 ierr = ISDestroy(&primals);CHKERRQ(ierr); 1005 for (i=0;i<nee;i++) { 1006 ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr); 1007 } 1008 ierr = PetscFree(eedges);CHKERRQ(ierr); 1009 } 1010 ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr); 1011 ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr); 1012 ierr = PetscFree(newprimals);CHKERRQ(ierr); 1013 ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr); 1014 ierr = ISDestroy(&primals);CHKERRQ(ierr); 1015 ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr); 1016 pcbddc->mat_graph->twodim = PETSC_FALSE; 1017 ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr); 1018 if (fl2g) { 1019 ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr); 1020 ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr); 1021 for (i=0;i<nee;i++) { 1022 ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr); 1023 } 1024 } else { 1025 eedges = alleedges; 1026 primals = allprimals; 1027 } 1028 ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr); 1029 1030 /* Mark again */ 1031 ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr); 1032 for (i=0;i<nee;i++) { 1033 PetscInt size,mark = i+1; 1034 1035 ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr); 1036 ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr); 1037 for (j=0;j<size;j++) marks[idxs[j]] = mark; 1038 ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr); 1039 } 1040 if (print) { 1041 ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr); 1042 ierr = ISView(primals,NULL);CHKERRQ(ierr); 1043 } 1044 1045 /* Recompute extended cols */ 1046 eerr = PETSC_FALSE; 1047 for (i=0;i<nee;i++) { 1048 PetscInt size; 1049 1050 cum = 0; 1051 ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr); 1052 if (!size && nedfieldlocal) continue; 1053 if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i); 1054 ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr); 1055 for (j=0;j<size;j++) { 1056 PetscInt k,ee = idxs[j]; 1057 for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k]; 1058 } 1059 ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr); 1060 ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr); 1061 ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr); 1062 ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr); 1063 ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr); 1064 if (cum != size -1) { 1065 if (print) { 1066 ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr); 1067 ierr = ISView(eedges[i],NULL);CHKERRQ(ierr); 1068 ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr); 1069 ierr = ISView(extcols[i],NULL);CHKERRQ(ierr); 1070 } 1071 eerr = PETSC_TRUE; 1072 } 1073 } 1074 } 1075 ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 1076 ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr); 1077 ierr = PetscBTDestroy(&bter);CHKERRQ(ierr); 1078 if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); } 1079 /* an error should not occur at this point */ 1080 if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS"); 1081 1082 /* Check the number of endpoints */ 1083 ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 1084 ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr); 1085 ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr); 1086 for (i=0;i<nee;i++) { 1087 PetscInt size, found = 0, gc[2]; 1088 1089 /* init with defaults */ 1090 cedges[i] = corners[i*2] = corners[i*2+1] = -1; 1091 ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr); 1092 if (!size && nedfieldlocal) continue; 1093 if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i); 1094 ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr); 1095 ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr); 1096 for (j=0;j<size;j++) { 1097 PetscInt k,ee = idxs[j]; 1098 for (k=ii[ee];k<ii[ee+1];k++) { 1099 PetscInt vv = jj[k]; 1100 if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) { 1101 if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %D",i); 1102 corners[i*2+found++] = vv; 1103 } 1104 } 1105 } 1106 if (found != 2) { 1107 PetscInt e; 1108 if (fl2g) { 1109 ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr); 1110 } else { 1111 e = idxs[0]; 1112 } 1113 SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %D corners for edge %D (astart %D, estart %D)",found,i,e,idxs[0]); 1114 } 1115 1116 /* get primal dof index on this coarse edge */ 1117 ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr); 1118 if (gc[0] > gc[1]) { 1119 PetscInt swap = corners[2*i]; 1120 corners[2*i] = corners[2*i+1]; 1121 corners[2*i+1] = swap; 1122 } 1123 cedges[i] = idxs[size-1]; 1124 ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr); 1125 if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %D: ce %D, corners (%D,%D)\n",i,cedges[i],corners[2*i],corners[2*i+1]); 1126 } 1127 ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 1128 ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr); 1129 1130 #if defined(PETSC_USE_DEBUG) 1131 /* Inspects columns of lG (rows of lGt) and make sure the change of basis will 1132 not interfere with neighbouring coarse edges */ 1133 ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr); 1134 ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 1135 for (i=0;i<nv;i++) { 1136 PetscInt emax = 0,eemax = 0; 1137 1138 if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue; 1139 ierr = PetscMemzero(emarks,(nee+1)*sizeof(PetscInt));CHKERRQ(ierr); 1140 for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++; 1141 for (j=1;j<nee+1;j++) { 1142 if (emax < emarks[j]) { 1143 emax = emarks[j]; 1144 eemax = j; 1145 } 1146 } 1147 /* not relevant for edges */ 1148 if (!eemax) continue; 1149 1150 for (j=ii[i];j<ii[i+1];j++) { 1151 if (marks[jj[j]] && marks[jj[j]] != eemax) { 1152 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]); 1153 } 1154 } 1155 } 1156 ierr = PetscFree(emarks);CHKERRQ(ierr); 1157 ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 1158 #endif 1159 1160 /* Compute extended rows indices for edge blocks of the change of basis */ 1161 ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 1162 ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr); 1163 extmem *= maxsize; 1164 ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr); 1165 ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr); 1166 ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr); 1167 for (i=0;i<nv;i++) { 1168 PetscInt mark = 0,size,start; 1169 1170 if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue; 1171 for (j=ii[i];j<ii[i+1];j++) 1172 if (marks[jj[j]] && !mark) 1173 mark = marks[jj[j]]; 1174 1175 /* not relevant */ 1176 if (!mark) continue; 1177 1178 /* import extended row */ 1179 mark--; 1180 start = mark*extmem+extrowcum[mark]; 1181 size = ii[i+1]-ii[i]; 1182 if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %D > %D",extrowcum[mark] + size,extmem); 1183 ierr = PetscMemcpy(extrow+start,jj+ii[i],size*sizeof(PetscInt));CHKERRQ(ierr); 1184 extrowcum[mark] += size; 1185 } 1186 ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr); 1187 ierr = MatDestroy(&lGt);CHKERRQ(ierr); 1188 ierr = PetscFree(marks);CHKERRQ(ierr); 1189 1190 /* Compress extrows */ 1191 cum = 0; 1192 for (i=0;i<nee;i++) { 1193 PetscInt size = extrowcum[i],*start = extrow + i*extmem; 1194 ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr); 1195 ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr); 1196 cum = PetscMax(cum,size); 1197 } 1198 ierr = PetscFree(extrowcum);CHKERRQ(ierr); 1199 ierr = PetscBTDestroy(&btv);CHKERRQ(ierr); 1200 ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr); 1201 1202 /* Workspace for lapack inner calls and VecSetValues */ 1203 ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr); 1204 1205 /* Create change of basis matrix (preallocation can be improved) */ 1206 ierr = MatCreate(comm,&T);CHKERRQ(ierr); 1207 ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n, 1208 pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr); 1209 ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr); 1210 ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr); 1211 ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr); 1212 ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr); 1213 ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr); 1214 ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr); 1215 ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr); 1216 1217 /* Defaults to identity */ 1218 ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr); 1219 ierr = VecSet(tvec,1.0);CHKERRQ(ierr); 1220 ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr); 1221 ierr = VecDestroy(&tvec);CHKERRQ(ierr); 1222 1223 /* Create discrete gradient for the coarser level if needed */ 1224 ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr); 1225 ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr); 1226 if (pcbddc->current_level < pcbddc->max_levels) { 1227 ISLocalToGlobalMapping cel2g,cvl2g; 1228 IS wis,gwis; 1229 PetscInt cnv,cne; 1230 1231 ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr); 1232 if (fl2g) { 1233 ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr); 1234 } else { 1235 ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr); 1236 pcbddc->nedclocal = wis; 1237 } 1238 ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr); 1239 ierr = ISDestroy(&wis);CHKERRQ(ierr); 1240 ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr); 1241 ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr); 1242 ierr = ISDestroy(&wis);CHKERRQ(ierr); 1243 ierr = ISDestroy(&gwis);CHKERRQ(ierr); 1244 1245 ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr); 1246 ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr); 1247 ierr = ISDestroy(&wis);CHKERRQ(ierr); 1248 ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr); 1249 ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr); 1250 ierr = ISDestroy(&wis);CHKERRQ(ierr); 1251 ierr = ISDestroy(&gwis);CHKERRQ(ierr); 1252 1253 ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr); 1254 ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr); 1255 ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr); 1256 ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr); 1257 ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr); 1258 ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr); 1259 ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr); 1260 ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr); 1261 } 1262 ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr); 1263 1264 #if defined(PRINT_GDET) 1265 inc = 0; 1266 lev = pcbddc->current_level; 1267 #endif 1268 1269 /* Insert values in the change of basis matrix */ 1270 for (i=0;i<nee;i++) { 1271 Mat Gins = NULL, GKins = NULL; 1272 IS cornersis = NULL; 1273 PetscScalar cvals[2]; 1274 1275 if (pcbddc->nedcG) { 1276 ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr); 1277 } 1278 ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr); 1279 if (Gins && GKins) { 1280 const PetscScalar *data; 1281 const PetscInt *rows,*cols; 1282 PetscInt nrh,nch,nrc,ncc; 1283 1284 ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr); 1285 /* H1 */ 1286 ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr); 1287 ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr); 1288 ierr = MatDenseGetArrayRead(Gins,&data);CHKERRQ(ierr); 1289 ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr); 1290 ierr = MatDenseRestoreArrayRead(Gins,&data);CHKERRQ(ierr); 1291 ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr); 1292 /* complement */ 1293 ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr); 1294 if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %D",i); 1295 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); 1296 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); 1297 ierr = MatDenseGetArrayRead(GKins,&data);CHKERRQ(ierr); 1298 ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr); 1299 ierr = MatDenseRestoreArrayRead(GKins,&data);CHKERRQ(ierr); 1300 1301 /* coarse discrete gradient */ 1302 if (pcbddc->nedcG) { 1303 PetscInt cols[2]; 1304 1305 cols[0] = 2*i; 1306 cols[1] = 2*i+1; 1307 ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr); 1308 } 1309 ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr); 1310 } 1311 ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr); 1312 ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr); 1313 ierr = ISDestroy(&cornersis);CHKERRQ(ierr); 1314 ierr = MatDestroy(&Gins);CHKERRQ(ierr); 1315 ierr = MatDestroy(&GKins);CHKERRQ(ierr); 1316 } 1317 ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr); 1318 1319 /* Start assembling */ 1320 ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 1321 if (pcbddc->nedcG) { 1322 ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 1323 } 1324 1325 /* Free */ 1326 if (fl2g) { 1327 ierr = ISDestroy(&primals);CHKERRQ(ierr); 1328 for (i=0;i<nee;i++) { 1329 ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr); 1330 } 1331 ierr = PetscFree(eedges);CHKERRQ(ierr); 1332 } 1333 1334 /* hack mat_graph with primal dofs on the coarse edges */ 1335 { 1336 PCBDDCGraph graph = pcbddc->mat_graph; 1337 PetscInt *oqueue = graph->queue; 1338 PetscInt *ocptr = graph->cptr; 1339 PetscInt ncc,*idxs; 1340 1341 /* find first primal edge */ 1342 if (pcbddc->nedclocal) { 1343 ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr); 1344 } else { 1345 if (fl2g) { 1346 ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr); 1347 } 1348 idxs = cedges; 1349 } 1350 cum = 0; 1351 while (cum < nee && cedges[cum] < 0) cum++; 1352 1353 /* adapt connected components */ 1354 ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr); 1355 graph->cptr[0] = 0; 1356 for (i=0,ncc=0;i<graph->ncc;i++) { 1357 PetscInt lc = ocptr[i+1]-ocptr[i]; 1358 if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */ 1359 graph->cptr[ncc+1] = graph->cptr[ncc]+1; 1360 graph->queue[graph->cptr[ncc]] = cedges[cum]; 1361 ncc++; 1362 lc--; 1363 cum++; 1364 while (cum < nee && cedges[cum] < 0) cum++; 1365 } 1366 graph->cptr[ncc+1] = graph->cptr[ncc] + lc; 1367 for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j]; 1368 ncc++; 1369 } 1370 graph->ncc = ncc; 1371 if (pcbddc->nedclocal) { 1372 ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr); 1373 } 1374 ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr); 1375 } 1376 ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr); 1377 ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr); 1378 ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr); 1379 ierr = MatDestroy(&conn);CHKERRQ(ierr); 1380 1381 ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr); 1382 ierr = PetscFree(extrow);CHKERRQ(ierr); 1383 ierr = PetscFree2(work,rwork);CHKERRQ(ierr); 1384 ierr = PetscFree(corners);CHKERRQ(ierr); 1385 ierr = PetscFree(cedges);CHKERRQ(ierr); 1386 ierr = PetscFree(extrows);CHKERRQ(ierr); 1387 ierr = PetscFree(extcols);CHKERRQ(ierr); 1388 ierr = MatDestroy(&lG);CHKERRQ(ierr); 1389 1390 /* Complete assembling */ 1391 ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 1392 if (pcbddc->nedcG) { 1393 ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 1394 #if 0 1395 ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr); 1396 ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr); 1397 #endif 1398 } 1399 1400 /* set change of basis */ 1401 ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr); 1402 ierr = MatDestroy(&T);CHKERRQ(ierr); 1403 1404 PetscFunctionReturn(0); 1405 } 1406 1407 /* the near-null space of BDDC carries information on quadrature weights, 1408 and these can be collinear -> so cheat with MatNullSpaceCreate 1409 and create a suitable set of basis vectors first */ 1410 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp) 1411 { 1412 PetscErrorCode ierr; 1413 PetscInt i; 1414 1415 PetscFunctionBegin; 1416 for (i=0;i<nvecs;i++) { 1417 PetscInt first,last; 1418 1419 ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr); 1420 if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented"); 1421 if (i>=first && i < last) { 1422 PetscScalar *data; 1423 ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr); 1424 if (!has_const) { 1425 data[i-first] = 1.; 1426 } else { 1427 data[2*i-first] = 1./PetscSqrtReal(2.); 1428 data[2*i-first+1] = -1./PetscSqrtReal(2.); 1429 } 1430 ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr); 1431 } 1432 ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr); 1433 } 1434 ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr); 1435 for (i=0;i<nvecs;i++) { /* reset vectors */ 1436 PetscInt first,last; 1437 ierr = VecLockReadPop(quad_vecs[i]);CHKERRQ(ierr); 1438 ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr); 1439 if (i>=first && i < last) { 1440 PetscScalar *data; 1441 ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr); 1442 if (!has_const) { 1443 data[i-first] = 0.; 1444 } else { 1445 data[2*i-first] = 0.; 1446 data[2*i-first+1] = 0.; 1447 } 1448 ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr); 1449 } 1450 ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr); 1451 ierr = VecLockReadPush(quad_vecs[i]);CHKERRQ(ierr); 1452 } 1453 PetscFunctionReturn(0); 1454 } 1455 1456 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp) 1457 { 1458 Mat loc_divudotp; 1459 Vec p,v,vins,quad_vec,*quad_vecs; 1460 ISLocalToGlobalMapping map; 1461 PetscScalar *vals; 1462 const PetscScalar *array; 1463 PetscInt i,maxneighs,maxsize,*gidxs; 1464 PetscInt n_neigh,*neigh,*n_shared,**shared; 1465 PetscMPIInt rank; 1466 PetscErrorCode ierr; 1467 1468 PetscFunctionBegin; 1469 ierr = ISLocalToGlobalMappingGetInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr); 1470 ierr = MPIU_Allreduce(&n_neigh,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr); 1471 if (!maxneighs) { 1472 ierr = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr); 1473 *nnsp = NULL; 1474 PetscFunctionReturn(0); 1475 } 1476 maxsize = 0; 1477 for (i=0;i<n_neigh;i++) maxsize = PetscMax(n_shared[i],maxsize); 1478 ierr = PetscMalloc2(maxsize,&gidxs,maxsize,&vals);CHKERRQ(ierr); 1479 /* create vectors to hold quadrature weights */ 1480 ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr); 1481 if (!transpose) { 1482 ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr); 1483 } else { 1484 ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr); 1485 } 1486 ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr); 1487 ierr = VecDestroy(&quad_vec);CHKERRQ(ierr); 1488 ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr); 1489 for (i=0;i<maxneighs;i++) { 1490 ierr = VecLockReadPop(quad_vecs[i]);CHKERRQ(ierr); 1491 } 1492 1493 /* compute local quad vec */ 1494 ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr); 1495 if (!transpose) { 1496 ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr); 1497 } else { 1498 ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr); 1499 } 1500 ierr = VecSet(p,1.);CHKERRQ(ierr); 1501 if (!transpose) { 1502 ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr); 1503 } else { 1504 ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr); 1505 } 1506 if (vl2l) { 1507 Mat lA; 1508 VecScatter sc; 1509 1510 ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr); 1511 ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr); 1512 ierr = VecScatterCreate(v,NULL,vins,vl2l,&sc);CHKERRQ(ierr); 1513 ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1514 ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1515 ierr = VecScatterDestroy(&sc);CHKERRQ(ierr); 1516 } else { 1517 vins = v; 1518 } 1519 ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr); 1520 ierr = VecDestroy(&p);CHKERRQ(ierr); 1521 1522 /* insert in global quadrature vecs */ 1523 ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr); 1524 for (i=0;i<n_neigh;i++) { 1525 const PetscInt *idxs; 1526 PetscInt idx,nn,j; 1527 1528 idxs = shared[i]; 1529 nn = n_shared[i]; 1530 for (j=0;j<nn;j++) vals[j] = array[idxs[j]]; 1531 ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr); 1532 idx = -(idx+1); 1533 ierr = ISLocalToGlobalMappingApply(map,nn,idxs,gidxs);CHKERRQ(ierr); 1534 ierr = VecSetValues(quad_vecs[idx],nn,gidxs,vals,INSERT_VALUES);CHKERRQ(ierr); 1535 } 1536 ierr = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr); 1537 ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr); 1538 if (vl2l) { 1539 ierr = VecDestroy(&vins);CHKERRQ(ierr); 1540 } 1541 ierr = VecDestroy(&v);CHKERRQ(ierr); 1542 ierr = PetscFree2(gidxs,vals);CHKERRQ(ierr); 1543 1544 /* assemble near null space */ 1545 for (i=0;i<maxneighs;i++) { 1546 ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr); 1547 } 1548 for (i=0;i<maxneighs;i++) { 1549 ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr); 1550 ierr = VecViewFromOptions(quad_vecs[i],NULL,"-pc_bddc_quad_vecs_view");CHKERRQ(ierr); 1551 ierr = VecLockReadPush(quad_vecs[i]);CHKERRQ(ierr); 1552 } 1553 ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr); 1554 PetscFunctionReturn(0); 1555 } 1556 1557 PetscErrorCode PCBDDCAddPrimalVerticesLocalIS(PC pc, IS primalv) 1558 { 1559 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 1560 PetscErrorCode ierr; 1561 1562 PetscFunctionBegin; 1563 if (primalv) { 1564 if (pcbddc->user_primal_vertices_local) { 1565 IS list[2], newp; 1566 1567 list[0] = primalv; 1568 list[1] = pcbddc->user_primal_vertices_local; 1569 ierr = ISConcatenate(PetscObjectComm((PetscObject)pc),2,list,&newp);CHKERRQ(ierr); 1570 ierr = ISSortRemoveDups(newp);CHKERRQ(ierr); 1571 ierr = ISDestroy(&list[1]);CHKERRQ(ierr); 1572 pcbddc->user_primal_vertices_local = newp; 1573 } else { 1574 ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr); 1575 } 1576 } 1577 PetscFunctionReturn(0); 1578 } 1579 1580 static PetscErrorCode func_coords_private(PetscInt dim, PetscReal t, const PetscReal X[], PetscInt Nf, PetscScalar *out, void *ctx) 1581 { 1582 PetscInt f, *comp = (PetscInt *)ctx; 1583 1584 PetscFunctionBegin; 1585 for (f=0;f<Nf;f++) out[f] = X[*comp]; 1586 PetscFunctionReturn(0); 1587 } 1588 1589 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc) 1590 { 1591 PetscErrorCode ierr; 1592 Vec local,global; 1593 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 1594 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 1595 PetscBool monolithic = PETSC_FALSE; 1596 1597 PetscFunctionBegin; 1598 ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC topology options","PC");CHKERRQ(ierr); 1599 ierr = PetscOptionsBool("-pc_bddc_monolithic","Discard any information on dofs splitting",NULL,monolithic,&monolithic,NULL);CHKERRQ(ierr); 1600 ierr = PetscOptionsEnd();CHKERRQ(ierr); 1601 /* need to convert from global to local topology information and remove references to information in global ordering */ 1602 ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr); 1603 ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr); 1604 if (monolithic) { /* just get block size to properly compute vertices */ 1605 if (pcbddc->vertex_size == 1) { 1606 ierr = MatGetBlockSize(pc->pmat,&pcbddc->vertex_size);CHKERRQ(ierr); 1607 } 1608 goto boundary; 1609 } 1610 1611 if (pcbddc->user_provided_isfordofs) { 1612 if (pcbddc->n_ISForDofs) { 1613 PetscInt i; 1614 1615 ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr); 1616 for (i=0;i<pcbddc->n_ISForDofs;i++) { 1617 PetscInt bs; 1618 1619 ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr); 1620 ierr = ISGetBlockSize(pcbddc->ISForDofs[i],&bs);CHKERRQ(ierr); 1621 ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr); 1622 ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr); 1623 } 1624 pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs; 1625 pcbddc->n_ISForDofs = 0; 1626 ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr); 1627 } 1628 } else { 1629 if (!pcbddc->n_ISForDofsLocal) { /* field split not present */ 1630 DM dm; 1631 1632 ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr); 1633 if (!dm) { 1634 ierr = PCGetDM(pc, &dm);CHKERRQ(ierr); 1635 } 1636 if (dm) { 1637 IS *fields; 1638 PetscInt nf,i; 1639 1640 ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr); 1641 ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr); 1642 for (i=0;i<nf;i++) { 1643 PetscInt bs; 1644 1645 ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr); 1646 ierr = ISGetBlockSize(fields[i],&bs);CHKERRQ(ierr); 1647 ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr); 1648 ierr = ISDestroy(&fields[i]);CHKERRQ(ierr); 1649 } 1650 ierr = PetscFree(fields);CHKERRQ(ierr); 1651 pcbddc->n_ISForDofsLocal = nf; 1652 } else { /* See if MATIS has fields attached by the conversion from MatNest */ 1653 PetscContainer c; 1654 1655 ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr); 1656 if (c) { 1657 MatISLocalFields lf; 1658 ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr); 1659 ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr); 1660 } else { /* fallback, create the default fields if bs > 1 */ 1661 PetscInt i, n = matis->A->rmap->n; 1662 ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr); 1663 if (i > 1) { 1664 pcbddc->n_ISForDofsLocal = i; 1665 ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr); 1666 for (i=0;i<pcbddc->n_ISForDofsLocal;i++) { 1667 ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr); 1668 } 1669 } 1670 } 1671 } 1672 } else { 1673 PetscInt i; 1674 for (i=0;i<pcbddc->n_ISForDofsLocal;i++) { 1675 ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr); 1676 } 1677 } 1678 } 1679 1680 boundary: 1681 if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) { 1682 ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr); 1683 } else if (pcbddc->DirichletBoundariesLocal) { 1684 ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr); 1685 } 1686 if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) { 1687 ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr); 1688 } else if (pcbddc->NeumannBoundariesLocal) { 1689 ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr); 1690 } 1691 if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) { 1692 ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr); 1693 } 1694 ierr = VecDestroy(&global);CHKERRQ(ierr); 1695 ierr = VecDestroy(&local);CHKERRQ(ierr); 1696 /* detect local disconnected subdomains if requested (use matis->A) */ 1697 if (pcbddc->detect_disconnected) { 1698 IS primalv = NULL; 1699 PetscInt i; 1700 PetscBool filter = pcbddc->detect_disconnected_filter; 1701 1702 for (i=0;i<pcbddc->n_local_subs;i++) { 1703 ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr); 1704 } 1705 ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr); 1706 ierr = PCBDDCDetectDisconnectedComponents(pc,filter,&pcbddc->n_local_subs,&pcbddc->local_subs,&primalv);CHKERRQ(ierr); 1707 ierr = PCBDDCAddPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr); 1708 ierr = ISDestroy(&primalv);CHKERRQ(ierr); 1709 } 1710 /* early stage corner detection */ 1711 { 1712 DM dm; 1713 1714 ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr); 1715 if (!dm) { 1716 ierr = PCGetDM(pc,&dm);CHKERRQ(ierr); 1717 } 1718 if (dm) { 1719 PetscBool isda; 1720 1721 ierr = PetscObjectTypeCompare((PetscObject)dm,DMDA,&isda);CHKERRQ(ierr); 1722 if (isda) { 1723 ISLocalToGlobalMapping l2l; 1724 IS corners; 1725 Mat lA; 1726 PetscBool gl,lo; 1727 1728 { 1729 Vec cvec; 1730 const PetscScalar *coords; 1731 PetscInt dof,n,cdim; 1732 PetscBool memc = PETSC_TRUE; 1733 1734 ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr); 1735 ierr = DMGetCoordinates(dm,&cvec);CHKERRQ(ierr); 1736 ierr = VecGetLocalSize(cvec,&n);CHKERRQ(ierr); 1737 ierr = VecGetBlockSize(cvec,&cdim);CHKERRQ(ierr); 1738 n /= cdim; 1739 ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr); 1740 ierr = PetscMalloc1(dof*n*cdim,&pcbddc->mat_graph->coords);CHKERRQ(ierr); 1741 ierr = VecGetArrayRead(cvec,&coords);CHKERRQ(ierr); 1742 #if defined(PETSC_USE_COMPLEX) 1743 memc = PETSC_FALSE; 1744 #endif 1745 if (dof != 1) memc = PETSC_FALSE; 1746 if (memc) { 1747 ierr = PetscMemcpy(pcbddc->mat_graph->coords,coords,cdim*n*dof*sizeof(PetscReal));CHKERRQ(ierr); 1748 } else { /* BDDC graph does not use any blocked information, we need to replicate the data */ 1749 PetscReal *bcoords = pcbddc->mat_graph->coords; 1750 PetscInt i, b, d; 1751 1752 for (i=0;i<n;i++) { 1753 for (b=0;b<dof;b++) { 1754 for (d=0;d<cdim;d++) { 1755 bcoords[i*dof*cdim + b*cdim + d] = PetscRealPart(coords[i*cdim+d]); 1756 } 1757 } 1758 } 1759 } 1760 ierr = VecRestoreArrayRead(cvec,&coords);CHKERRQ(ierr); 1761 pcbddc->mat_graph->cdim = cdim; 1762 pcbddc->mat_graph->cnloc = dof*n; 1763 pcbddc->mat_graph->cloc = PETSC_FALSE; 1764 } 1765 ierr = DMDAGetSubdomainCornersIS(dm,&corners);CHKERRQ(ierr); 1766 ierr = MatISGetLocalMat(pc->pmat,&lA);CHKERRQ(ierr); 1767 ierr = MatGetLocalToGlobalMapping(lA,&l2l,NULL);CHKERRQ(ierr); 1768 ierr = MatISRestoreLocalMat(pc->pmat,&lA);CHKERRQ(ierr); 1769 lo = (PetscBool)(l2l && corners); 1770 ierr = MPIU_Allreduce(&lo,&gl,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr); 1771 if (gl) { /* From PETSc's DMDA */ 1772 const PetscInt *idx; 1773 PetscInt dof,bs,*idxout,n; 1774 1775 ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr); 1776 ierr = ISLocalToGlobalMappingGetBlockSize(l2l,&bs);CHKERRQ(ierr); 1777 ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr); 1778 ierr = ISGetIndices(corners,&idx);CHKERRQ(ierr); 1779 if (bs == dof) { 1780 ierr = PetscMalloc1(n,&idxout);CHKERRQ(ierr); 1781 ierr = ISLocalToGlobalMappingApplyBlock(l2l,n,idx,idxout);CHKERRQ(ierr); 1782 } else { /* the original DMDA local-to-local map have been modified */ 1783 PetscInt i,d; 1784 1785 ierr = PetscMalloc1(dof*n,&idxout);CHKERRQ(ierr); 1786 for (i=0;i<n;i++) for (d=0;d<dof;d++) idxout[dof*i+d] = dof*idx[i]+d; 1787 ierr = ISLocalToGlobalMappingApply(l2l,dof*n,idxout,idxout);CHKERRQ(ierr); 1788 1789 bs = 1; 1790 n *= dof; 1791 } 1792 ierr = ISRestoreIndices(corners,&idx);CHKERRQ(ierr); 1793 ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr); 1794 ierr = ISCreateBlock(PetscObjectComm((PetscObject)pc),bs,n,idxout,PETSC_OWN_POINTER,&corners);CHKERRQ(ierr); 1795 ierr = PCBDDCAddPrimalVerticesLocalIS(pc,corners);CHKERRQ(ierr); 1796 ierr = ISDestroy(&corners);CHKERRQ(ierr); 1797 pcbddc->corner_selected = PETSC_TRUE; 1798 pcbddc->corner_selection = PETSC_TRUE; 1799 } 1800 if (corners) { 1801 ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr); 1802 } 1803 } 1804 } 1805 } 1806 if (pcbddc->corner_selection && !pcbddc->mat_graph->cdim) { 1807 DM dm; 1808 1809 ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr); 1810 if (!dm) { 1811 ierr = PCGetDM(pc,&dm);CHKERRQ(ierr); 1812 } 1813 if (dm) { /* this can get very expensive, I need to find a faster alternative */ 1814 Vec vcoords; 1815 PetscSection section; 1816 PetscReal *coords; 1817 PetscInt d,cdim,nl,nf,**ctxs; 1818 PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *); 1819 1820 ierr = DMGetCoordinateDim(dm,&cdim);CHKERRQ(ierr); 1821 ierr = DMGetSection(dm,§ion);CHKERRQ(ierr); 1822 ierr = PetscSectionGetNumFields(section,&nf);CHKERRQ(ierr); 1823 ierr = DMCreateGlobalVector(dm,&vcoords);CHKERRQ(ierr); 1824 ierr = VecGetLocalSize(vcoords,&nl);CHKERRQ(ierr); 1825 ierr = PetscMalloc1(nl*cdim,&coords);CHKERRQ(ierr); 1826 ierr = PetscMalloc2(nf,&funcs,nf,&ctxs);CHKERRQ(ierr); 1827 ierr = PetscMalloc1(nf,&ctxs[0]);CHKERRQ(ierr); 1828 for (d=0;d<nf;d++) funcs[d] = func_coords_private; 1829 for (d=1;d<nf;d++) ctxs[d] = ctxs[d-1] + 1; 1830 for (d=0;d<cdim;d++) { 1831 PetscInt i; 1832 const PetscScalar *v; 1833 1834 for (i=0;i<nf;i++) ctxs[i][0] = d; 1835 ierr = DMProjectFunction(dm,0.0,funcs,(void**)ctxs,INSERT_VALUES,vcoords);CHKERRQ(ierr); 1836 ierr = VecGetArrayRead(vcoords,&v);CHKERRQ(ierr); 1837 for (i=0;i<nl;i++) coords[i*cdim+d] = PetscRealPart(v[i]); 1838 ierr = VecRestoreArrayRead(vcoords,&v);CHKERRQ(ierr); 1839 } 1840 ierr = VecDestroy(&vcoords);CHKERRQ(ierr); 1841 ierr = PCSetCoordinates(pc,cdim,nl,coords);CHKERRQ(ierr); 1842 ierr = PetscFree(coords);CHKERRQ(ierr); 1843 ierr = PetscFree(ctxs[0]);CHKERRQ(ierr); 1844 ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr); 1845 } 1846 } 1847 PetscFunctionReturn(0); 1848 } 1849 1850 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is) 1851 { 1852 Mat_IS *matis = (Mat_IS*)(pc->pmat->data); 1853 PetscErrorCode ierr; 1854 IS nis; 1855 const PetscInt *idxs; 1856 PetscInt i,nd,n = matis->A->rmap->n,*nidxs,nnd; 1857 PetscBool *ld; 1858 1859 PetscFunctionBegin; 1860 if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR"); 1861 if (mop == MPI_LAND) { 1862 /* init rootdata with true */ 1863 ld = (PetscBool*) matis->sf_rootdata; 1864 for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE; 1865 } else { 1866 ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr); 1867 } 1868 ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));CHKERRQ(ierr); 1869 ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr); 1870 ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr); 1871 ld = (PetscBool*) matis->sf_leafdata; 1872 for (i=0;i<nd;i++) 1873 if (-1 < idxs[i] && idxs[i] < n) 1874 ld[idxs[i]] = PETSC_TRUE; 1875 ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr); 1876 ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr); 1877 ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr); 1878 ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr); 1879 ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr); 1880 if (mop == MPI_LAND) { 1881 ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr); 1882 } else { 1883 ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr); 1884 } 1885 for (i=0,nnd=0;i<n;i++) 1886 if (ld[i]) 1887 nidxs[nnd++] = i; 1888 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr); 1889 ierr = ISDestroy(is);CHKERRQ(ierr); 1890 *is = nis; 1891 PetscFunctionReturn(0); 1892 } 1893 1894 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z) 1895 { 1896 PC_IS *pcis = (PC_IS*)(pc->data); 1897 PC_BDDC *pcbddc = (PC_BDDC*)(pc->data); 1898 PetscErrorCode ierr; 1899 1900 PetscFunctionBegin; 1901 if (!pcbddc->benign_have_null) { 1902 PetscFunctionReturn(0); 1903 } 1904 if (pcbddc->ChangeOfBasisMatrix) { 1905 Vec swap; 1906 1907 ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr); 1908 swap = pcbddc->work_change; 1909 pcbddc->work_change = r; 1910 r = swap; 1911 } 1912 ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1913 ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1914 ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr); 1915 ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr); 1916 ierr = VecSet(z,0.);CHKERRQ(ierr); 1917 ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1918 ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 1919 if (pcbddc->ChangeOfBasisMatrix) { 1920 pcbddc->work_change = r; 1921 ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr); 1922 ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr); 1923 } 1924 PetscFunctionReturn(0); 1925 } 1926 1927 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose) 1928 { 1929 PCBDDCBenignMatMult_ctx ctx; 1930 PetscErrorCode ierr; 1931 PetscBool apply_right,apply_left,reset_x; 1932 1933 PetscFunctionBegin; 1934 ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr); 1935 if (transpose) { 1936 apply_right = ctx->apply_left; 1937 apply_left = ctx->apply_right; 1938 } else { 1939 apply_right = ctx->apply_right; 1940 apply_left = ctx->apply_left; 1941 } 1942 reset_x = PETSC_FALSE; 1943 if (apply_right) { 1944 const PetscScalar *ax; 1945 PetscInt nl,i; 1946 1947 ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr); 1948 ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr); 1949 ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr); 1950 ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr); 1951 for (i=0;i<ctx->benign_n;i++) { 1952 PetscScalar sum,val; 1953 const PetscInt *idxs; 1954 PetscInt nz,j; 1955 ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr); 1956 ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr); 1957 sum = 0.; 1958 if (ctx->apply_p0) { 1959 val = ctx->work[idxs[nz-1]]; 1960 for (j=0;j<nz-1;j++) { 1961 sum += ctx->work[idxs[j]]; 1962 ctx->work[idxs[j]] += val; 1963 } 1964 } else { 1965 for (j=0;j<nz-1;j++) { 1966 sum += ctx->work[idxs[j]]; 1967 } 1968 } 1969 ctx->work[idxs[nz-1]] -= sum; 1970 ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr); 1971 } 1972 ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr); 1973 reset_x = PETSC_TRUE; 1974 } 1975 if (transpose) { 1976 ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr); 1977 } else { 1978 ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr); 1979 } 1980 if (reset_x) { 1981 ierr = VecResetArray(x);CHKERRQ(ierr); 1982 } 1983 if (apply_left) { 1984 PetscScalar *ay; 1985 PetscInt i; 1986 1987 ierr = VecGetArray(y,&ay);CHKERRQ(ierr); 1988 for (i=0;i<ctx->benign_n;i++) { 1989 PetscScalar sum,val; 1990 const PetscInt *idxs; 1991 PetscInt nz,j; 1992 ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr); 1993 ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr); 1994 val = -ay[idxs[nz-1]]; 1995 if (ctx->apply_p0) { 1996 sum = 0.; 1997 for (j=0;j<nz-1;j++) { 1998 sum += ay[idxs[j]]; 1999 ay[idxs[j]] += val; 2000 } 2001 ay[idxs[nz-1]] += sum; 2002 } else { 2003 for (j=0;j<nz-1;j++) { 2004 ay[idxs[j]] += val; 2005 } 2006 ay[idxs[nz-1]] = 0.; 2007 } 2008 ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr); 2009 } 2010 ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr); 2011 } 2012 PetscFunctionReturn(0); 2013 } 2014 2015 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y) 2016 { 2017 PetscErrorCode ierr; 2018 2019 PetscFunctionBegin; 2020 ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr); 2021 PetscFunctionReturn(0); 2022 } 2023 2024 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y) 2025 { 2026 PetscErrorCode ierr; 2027 2028 PetscFunctionBegin; 2029 ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr); 2030 PetscFunctionReturn(0); 2031 } 2032 2033 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore) 2034 { 2035 PC_IS *pcis = (PC_IS*)pc->data; 2036 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 2037 PCBDDCBenignMatMult_ctx ctx; 2038 PetscErrorCode ierr; 2039 2040 PetscFunctionBegin; 2041 if (!restore) { 2042 Mat A_IB,A_BI; 2043 PetscScalar *work; 2044 PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL; 2045 2046 if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored"); 2047 if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0); 2048 ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr); 2049 ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr); 2050 ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr); 2051 ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr); 2052 ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr); 2053 ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr); 2054 ierr = PetscNew(&ctx);CHKERRQ(ierr); 2055 ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr); 2056 ctx->apply_left = PETSC_TRUE; 2057 ctx->apply_right = PETSC_FALSE; 2058 ctx->apply_p0 = PETSC_FALSE; 2059 ctx->benign_n = pcbddc->benign_n; 2060 if (reuse) { 2061 ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs; 2062 ctx->free = PETSC_FALSE; 2063 } else { /* TODO: could be optimized for successive solves */ 2064 ISLocalToGlobalMapping N_to_D; 2065 PetscInt i; 2066 2067 ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr); 2068 ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr); 2069 for (i=0;i<pcbddc->benign_n;i++) { 2070 ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr); 2071 } 2072 ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr); 2073 ctx->free = PETSC_TRUE; 2074 } 2075 ctx->A = pcis->A_IB; 2076 ctx->work = work; 2077 ierr = MatSetUp(A_IB);CHKERRQ(ierr); 2078 ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2079 ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2080 pcis->A_IB = A_IB; 2081 2082 /* A_BI as A_IB^T */ 2083 ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr); 2084 pcbddc->benign_original_mat = pcis->A_BI; 2085 pcis->A_BI = A_BI; 2086 } else { 2087 if (!pcbddc->benign_original_mat) { 2088 PetscFunctionReturn(0); 2089 } 2090 ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr); 2091 ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr); 2092 pcis->A_IB = ctx->A; 2093 ctx->A = NULL; 2094 ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr); 2095 pcis->A_BI = pcbddc->benign_original_mat; 2096 pcbddc->benign_original_mat = NULL; 2097 if (ctx->free) { 2098 PetscInt i; 2099 for (i=0;i<ctx->benign_n;i++) { 2100 ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr); 2101 } 2102 ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr); 2103 } 2104 ierr = PetscFree(ctx->work);CHKERRQ(ierr); 2105 ierr = PetscFree(ctx);CHKERRQ(ierr); 2106 } 2107 PetscFunctionReturn(0); 2108 } 2109 2110 /* used just in bddc debug mode */ 2111 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B) 2112 { 2113 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 2114 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 2115 Mat An; 2116 PetscErrorCode ierr; 2117 2118 PetscFunctionBegin; 2119 ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr); 2120 ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr); 2121 if (is1) { 2122 ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr); 2123 ierr = MatDestroy(&An);CHKERRQ(ierr); 2124 } else { 2125 *B = An; 2126 } 2127 PetscFunctionReturn(0); 2128 } 2129 2130 /* TODO: add reuse flag */ 2131 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B) 2132 { 2133 Mat Bt; 2134 PetscScalar *a,*bdata; 2135 const PetscInt *ii,*ij; 2136 PetscInt m,n,i,nnz,*bii,*bij; 2137 PetscBool flg_row; 2138 PetscErrorCode ierr; 2139 2140 PetscFunctionBegin; 2141 ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr); 2142 ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr); 2143 ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr); 2144 nnz = n; 2145 for (i=0;i<ii[n];i++) { 2146 if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++; 2147 } 2148 ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr); 2149 ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr); 2150 ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr); 2151 nnz = 0; 2152 bii[0] = 0; 2153 for (i=0;i<n;i++) { 2154 PetscInt j; 2155 for (j=ii[i];j<ii[i+1];j++) { 2156 PetscScalar entry = a[j]; 2157 if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || (n == m && ij[j] == i)) { 2158 bij[nnz] = ij[j]; 2159 bdata[nnz] = entry; 2160 nnz++; 2161 } 2162 } 2163 bii[i+1] = nnz; 2164 } 2165 ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr); 2166 ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr); 2167 ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr); 2168 { 2169 Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data); 2170 b->free_a = PETSC_TRUE; 2171 b->free_ij = PETSC_TRUE; 2172 } 2173 if (*B == A) { 2174 ierr = MatDestroy(&A);CHKERRQ(ierr); 2175 } 2176 *B = Bt; 2177 PetscFunctionReturn(0); 2178 } 2179 2180 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscBool filter, PetscInt *ncc, IS* cc[], IS* primalv) 2181 { 2182 Mat B = NULL; 2183 DM dm; 2184 IS is_dummy,*cc_n; 2185 ISLocalToGlobalMapping l2gmap_dummy; 2186 PCBDDCGraph graph; 2187 PetscInt *xadj_filtered = NULL,*adjncy_filtered = NULL; 2188 PetscInt i,n; 2189 PetscInt *xadj,*adjncy; 2190 PetscBool isplex = PETSC_FALSE; 2191 PetscErrorCode ierr; 2192 2193 PetscFunctionBegin; 2194 if (ncc) *ncc = 0; 2195 if (cc) *cc = NULL; 2196 if (primalv) *primalv = NULL; 2197 ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr); 2198 ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr); 2199 if (!dm) { 2200 ierr = PCGetDM(pc,&dm);CHKERRQ(ierr); 2201 } 2202 if (dm) { 2203 ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr); 2204 } 2205 if (filter) isplex = PETSC_FALSE; 2206 2207 if (isplex) { /* this code has been modified from plexpartition.c */ 2208 PetscInt p, pStart, pEnd, a, adjSize, idx, size, nroots; 2209 PetscInt *adj = NULL; 2210 IS cellNumbering; 2211 const PetscInt *cellNum; 2212 PetscBool useCone, useClosure; 2213 PetscSection section; 2214 PetscSegBuffer adjBuffer; 2215 PetscSF sfPoint; 2216 PetscErrorCode ierr; 2217 2218 PetscFunctionBegin; 2219 ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr); 2220 ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr); 2221 ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr); 2222 /* Build adjacency graph via a section/segbuffer */ 2223 ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), §ion);CHKERRQ(ierr); 2224 ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr); 2225 ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr); 2226 /* Always use FVM adjacency to create partitioner graph */ 2227 ierr = DMGetBasicAdjacency(dm, &useCone, &useClosure);CHKERRQ(ierr); 2228 ierr = DMSetBasicAdjacency(dm, PETSC_TRUE, PETSC_FALSE);CHKERRQ(ierr); 2229 ierr = DMPlexGetCellNumbering(dm, &cellNumbering);CHKERRQ(ierr); 2230 ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr); 2231 for (n = 0, p = pStart; p < pEnd; p++) { 2232 /* Skip non-owned cells in parallel (ParMetis expects no overlap) */ 2233 if (nroots > 0) {if (cellNum[p] < 0) continue;} 2234 adjSize = PETSC_DETERMINE; 2235 ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr); 2236 for (a = 0; a < adjSize; ++a) { 2237 const PetscInt point = adj[a]; 2238 if (pStart <= point && point < pEnd) { 2239 PetscInt *PETSC_RESTRICT pBuf; 2240 ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr); 2241 ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr); 2242 *pBuf = point; 2243 } 2244 } 2245 n++; 2246 } 2247 ierr = DMSetBasicAdjacency(dm, useCone, useClosure);CHKERRQ(ierr); 2248 /* Derive CSR graph from section/segbuffer */ 2249 ierr = PetscSectionSetUp(section);CHKERRQ(ierr); 2250 ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr); 2251 ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr); 2252 for (idx = 0, p = pStart; p < pEnd; p++) { 2253 if (nroots > 0) {if (cellNum[p] < 0) continue;} 2254 ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr); 2255 } 2256 xadj[n] = size; 2257 ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr); 2258 /* Clean up */ 2259 ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr); 2260 ierr = PetscSectionDestroy(§ion);CHKERRQ(ierr); 2261 ierr = PetscFree(adj);CHKERRQ(ierr); 2262 graph->xadj = xadj; 2263 graph->adjncy = adjncy; 2264 } else { 2265 Mat A; 2266 PetscBool isseqaij, flg_row; 2267 2268 ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr); 2269 if (!A->rmap->N || !A->cmap->N) { 2270 ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr); 2271 PetscFunctionReturn(0); 2272 } 2273 ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr); 2274 if (!isseqaij && filter) { 2275 PetscBool isseqdense; 2276 2277 ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr); 2278 if (!isseqdense) { 2279 ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr); 2280 } else { /* TODO: rectangular case and LDA */ 2281 PetscScalar *array; 2282 PetscReal chop=1.e-6; 2283 2284 ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr); 2285 ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr); 2286 ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr); 2287 for (i=0;i<n;i++) { 2288 PetscInt j; 2289 for (j=i+1;j<n;j++) { 2290 PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)])); 2291 if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.; 2292 if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.; 2293 } 2294 } 2295 ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr); 2296 ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr); 2297 } 2298 } else { 2299 ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr); 2300 B = A; 2301 } 2302 ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr); 2303 2304 /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */ 2305 if (filter) { 2306 PetscScalar *data; 2307 PetscInt j,cum; 2308 2309 ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr); 2310 ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr); 2311 cum = 0; 2312 for (i=0;i<n;i++) { 2313 PetscInt t; 2314 2315 for (j=xadj[i];j<xadj[i+1];j++) { 2316 if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) { 2317 continue; 2318 } 2319 adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j]; 2320 } 2321 t = xadj_filtered[i]; 2322 xadj_filtered[i] = cum; 2323 cum += t; 2324 } 2325 ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr); 2326 graph->xadj = xadj_filtered; 2327 graph->adjncy = adjncy_filtered; 2328 } else { 2329 graph->xadj = xadj; 2330 graph->adjncy = adjncy; 2331 } 2332 } 2333 /* compute local connected components using PCBDDCGraph */ 2334 ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr); 2335 ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr); 2336 ierr = ISDestroy(&is_dummy);CHKERRQ(ierr); 2337 ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr); 2338 ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr); 2339 ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr); 2340 ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr); 2341 2342 /* partial clean up */ 2343 ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr); 2344 if (B) { 2345 PetscBool flg_row; 2346 ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr); 2347 ierr = MatDestroy(&B);CHKERRQ(ierr); 2348 } 2349 if (isplex) { 2350 ierr = PetscFree(xadj);CHKERRQ(ierr); 2351 ierr = PetscFree(adjncy);CHKERRQ(ierr); 2352 } 2353 2354 /* get back data */ 2355 if (isplex) { 2356 if (ncc) *ncc = graph->ncc; 2357 if (cc || primalv) { 2358 Mat A; 2359 PetscBT btv,btvt; 2360 PetscSection subSection; 2361 PetscInt *ids,cum,cump,*cids,*pids; 2362 2363 ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr); 2364 ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr); 2365 ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr); 2366 ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr); 2367 ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr); 2368 2369 cids[0] = 0; 2370 for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) { 2371 PetscInt j; 2372 2373 ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr); 2374 for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) { 2375 PetscInt k, size, *closure = NULL, cell = graph->queue[j]; 2376 2377 ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr); 2378 for (k = 0; k < 2*size; k += 2) { 2379 PetscInt s, p = closure[k], off, dof, cdof; 2380 2381 ierr = PetscSectionGetConstraintDof(subSection, p, &cdof);CHKERRQ(ierr); 2382 ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr); 2383 ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr); 2384 for (s = 0; s < dof-cdof; s++) { 2385 if (PetscBTLookupSet(btvt,off+s)) continue; 2386 if (!PetscBTLookup(btv,off+s)) { 2387 ids[cum++] = off+s; 2388 } else { /* cross-vertex */ 2389 pids[cump++] = off+s; 2390 } 2391 } 2392 } 2393 ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr); 2394 } 2395 cids[i+1] = cum; 2396 /* mark dofs as already assigned */ 2397 for (j = cids[i]; j < cids[i+1]; j++) { 2398 ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr); 2399 } 2400 } 2401 if (cc) { 2402 ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr); 2403 for (i = 0; i < graph->ncc; i++) { 2404 ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr); 2405 } 2406 *cc = cc_n; 2407 } 2408 if (primalv) { 2409 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr); 2410 } 2411 ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr); 2412 ierr = PetscBTDestroy(&btv);CHKERRQ(ierr); 2413 ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr); 2414 } 2415 } else { 2416 if (ncc) *ncc = graph->ncc; 2417 if (cc) { 2418 ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr); 2419 for (i=0;i<graph->ncc;i++) { 2420 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); 2421 } 2422 *cc = cc_n; 2423 } 2424 } 2425 /* clean up graph */ 2426 graph->xadj = 0; 2427 graph->adjncy = 0; 2428 ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr); 2429 PetscFunctionReturn(0); 2430 } 2431 2432 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag) 2433 { 2434 PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 2435 PC_IS* pcis = (PC_IS*)(pc->data); 2436 IS dirIS = NULL; 2437 PetscInt i; 2438 PetscErrorCode ierr; 2439 2440 PetscFunctionBegin; 2441 ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr); 2442 if (zerodiag) { 2443 Mat A; 2444 Vec vec3_N; 2445 PetscScalar *vals; 2446 const PetscInt *idxs; 2447 PetscInt nz,*count; 2448 2449 /* p0 */ 2450 ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr); 2451 ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr); 2452 ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr); 2453 ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr); 2454 for (i=0;i<nz;i++) vals[i] = 1.; 2455 ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr); 2456 ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr); 2457 ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr); 2458 /* v_I */ 2459 ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr); 2460 for (i=0;i<nz;i++) vals[i] = 0.; 2461 ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr); 2462 ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr); 2463 ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr); 2464 for (i=0;i<pcis->n_B;i++) vals[i] = 0.; 2465 ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr); 2466 ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr); 2467 if (dirIS) { 2468 PetscInt n; 2469 2470 ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr); 2471 ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr); 2472 for (i=0;i<n;i++) vals[i] = 0.; 2473 ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr); 2474 ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr); 2475 } 2476 ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr); 2477 ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr); 2478 ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr); 2479 ierr = VecSet(vec3_N,0.);CHKERRQ(ierr); 2480 ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr); 2481 ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr); 2482 ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr); 2483 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])); 2484 ierr = PetscFree(vals);CHKERRQ(ierr); 2485 ierr = VecDestroy(&vec3_N);CHKERRQ(ierr); 2486 2487 /* there should not be any pressure dofs lying on the interface */ 2488 ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr); 2489 ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr); 2490 for (i=0;i<pcis->n_B;i++) count[idxs[i]]++; 2491 ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr); 2492 ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr); 2493 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]); 2494 ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr); 2495 ierr = PetscFree(count);CHKERRQ(ierr); 2496 } 2497 ierr = ISDestroy(&dirIS);CHKERRQ(ierr); 2498 2499 /* check PCBDDCBenignGetOrSetP0 */ 2500 ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr); 2501 for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i; 2502 ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr); 2503 for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1; 2504 ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr); 2505 for (i=0;i<pcbddc->benign_n;i++) { 2506 PetscInt val = PetscRealPart(pcbddc->benign_p0[i]); 2507 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); 2508 } 2509 PetscFunctionReturn(0); 2510 } 2511 2512 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, PetscBool reuse, IS *zerodiaglocal) 2513 { 2514 PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 2515 IS pressures = NULL,zerodiag = NULL,*bzerodiag = NULL,zerodiag_save,*zerodiag_subs; 2516 PetscInt nz,n,benign_n,bsp = 1; 2517 PetscInt *interior_dofs,n_interior_dofs,nneu; 2518 PetscBool sorted,have_null,has_null_pressures,recompute_zerodiag,checkb; 2519 PetscErrorCode ierr; 2520 2521 PetscFunctionBegin; 2522 if (reuse) goto project_b0; 2523 ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr); 2524 ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr); 2525 for (n=0;n<pcbddc->benign_n;n++) { 2526 ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr); 2527 } 2528 ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr); 2529 has_null_pressures = PETSC_TRUE; 2530 have_null = PETSC_TRUE; 2531 /* if a local information on dofs is present, gets pressure dofs from command line (uses the last field is not provided) 2532 Without local information, it uses only the zerodiagonal dofs (ok if the pressure block is all zero and it is a scalar field) 2533 Checks if all the pressure dofs in each subdomain have a zero diagonal 2534 If not, a change of basis on pressures is not needed 2535 since the local Schur complements are already SPD 2536 */ 2537 if (pcbddc->n_ISForDofsLocal) { 2538 IS iP = NULL; 2539 PetscInt p,*pp; 2540 PetscBool flg; 2541 2542 ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pp);CHKERRQ(ierr); 2543 n = pcbddc->n_ISForDofsLocal; 2544 ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr); 2545 ierr = PetscOptionsIntArray("-pc_bddc_pressure_field","Field id for pressures",NULL,pp,&n,&flg);CHKERRQ(ierr); 2546 ierr = PetscOptionsEnd();CHKERRQ(ierr); 2547 if (!flg) { 2548 n = 1; 2549 pp[0] = pcbddc->n_ISForDofsLocal-1; 2550 } 2551 2552 bsp = 0; 2553 for (p=0;p<n;p++) { 2554 PetscInt bs; 2555 2556 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]); 2557 ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr); 2558 bsp += bs; 2559 } 2560 ierr = PetscMalloc1(bsp,&bzerodiag);CHKERRQ(ierr); 2561 bsp = 0; 2562 for (p=0;p<n;p++) { 2563 const PetscInt *idxs; 2564 PetscInt b,bs,npl,*bidxs; 2565 2566 ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr); 2567 ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[pp[p]],&npl);CHKERRQ(ierr); 2568 ierr = ISGetIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr); 2569 ierr = PetscMalloc1(npl/bs,&bidxs);CHKERRQ(ierr); 2570 for (b=0;b<bs;b++) { 2571 PetscInt i; 2572 2573 for (i=0;i<npl/bs;i++) bidxs[i] = idxs[bs*i+b]; 2574 ierr = ISCreateGeneral(PETSC_COMM_SELF,npl/bs,bidxs,PETSC_COPY_VALUES,&bzerodiag[bsp]);CHKERRQ(ierr); 2575 bsp++; 2576 } 2577 ierr = PetscFree(bidxs);CHKERRQ(ierr); 2578 ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr); 2579 } 2580 ierr = ISConcatenate(PETSC_COMM_SELF,bsp,bzerodiag,&pressures);CHKERRQ(ierr); 2581 2582 /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */ 2583 ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr); 2584 if (iP) { 2585 IS newpressures; 2586 2587 ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr); 2588 ierr = ISDestroy(&pressures);CHKERRQ(ierr); 2589 pressures = newpressures; 2590 } 2591 ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr); 2592 if (!sorted) { 2593 ierr = ISSort(pressures);CHKERRQ(ierr); 2594 } 2595 ierr = PetscFree(pp);CHKERRQ(ierr); 2596 } 2597 2598 /* pcis has not been setup yet, so get the local size from the subdomain matrix */ 2599 ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr); 2600 if (!n) pcbddc->benign_change_explicit = PETSC_TRUE; 2601 ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr); 2602 ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr); 2603 if (!sorted) { 2604 ierr = ISSort(zerodiag);CHKERRQ(ierr); 2605 } 2606 ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr); 2607 zerodiag_save = zerodiag; 2608 ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr); 2609 if (!nz) { 2610 if (n) have_null = PETSC_FALSE; 2611 has_null_pressures = PETSC_FALSE; 2612 ierr = ISDestroy(&zerodiag);CHKERRQ(ierr); 2613 } 2614 recompute_zerodiag = PETSC_FALSE; 2615 2616 /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */ 2617 zerodiag_subs = NULL; 2618 benign_n = 0; 2619 n_interior_dofs = 0; 2620 interior_dofs = NULL; 2621 nneu = 0; 2622 if (pcbddc->NeumannBoundariesLocal) { 2623 ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr); 2624 } 2625 checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level); 2626 if (checkb) { /* need to compute interior nodes */ 2627 PetscInt n,i,j; 2628 PetscInt n_neigh,*neigh,*n_shared,**shared; 2629 PetscInt *iwork; 2630 2631 ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr); 2632 ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr); 2633 ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr); 2634 ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr); 2635 for (i=1;i<n_neigh;i++) 2636 for (j=0;j<n_shared[i];j++) 2637 iwork[shared[i][j]] += 1; 2638 for (i=0;i<n;i++) 2639 if (!iwork[i]) 2640 interior_dofs[n_interior_dofs++] = i; 2641 ierr = PetscFree(iwork);CHKERRQ(ierr); 2642 ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr); 2643 } 2644 if (has_null_pressures) { 2645 IS *subs; 2646 PetscInt nsubs,i,j,nl; 2647 const PetscInt *idxs; 2648 PetscScalar *array; 2649 Vec *work; 2650 Mat_IS* matis = (Mat_IS*)(pc->pmat->data); 2651 2652 subs = pcbddc->local_subs; 2653 nsubs = pcbddc->n_local_subs; 2654 /* 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) */ 2655 if (checkb) { 2656 ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr); 2657 ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr); 2658 ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr); 2659 /* work[0] = 1_p */ 2660 ierr = VecSet(work[0],0.);CHKERRQ(ierr); 2661 ierr = VecGetArray(work[0],&array);CHKERRQ(ierr); 2662 for (j=0;j<nl;j++) array[idxs[j]] = 1.; 2663 ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr); 2664 /* work[0] = 1_v */ 2665 ierr = VecSet(work[1],1.);CHKERRQ(ierr); 2666 ierr = VecGetArray(work[1],&array);CHKERRQ(ierr); 2667 for (j=0;j<nl;j++) array[idxs[j]] = 0.; 2668 ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr); 2669 ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr); 2670 } 2671 2672 if (nsubs > 1 || bsp > 1) { 2673 IS *is; 2674 PetscInt b,totb; 2675 2676 totb = bsp; 2677 is = bsp > 1 ? bzerodiag : &zerodiag; 2678 nsubs = PetscMax(nsubs,1); 2679 ierr = PetscCalloc1(nsubs*totb,&zerodiag_subs);CHKERRQ(ierr); 2680 for (b=0;b<totb;b++) { 2681 for (i=0;i<nsubs;i++) { 2682 ISLocalToGlobalMapping l2g; 2683 IS t_zerodiag_subs; 2684 PetscInt nl; 2685 2686 if (subs) { 2687 ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr); 2688 } else { 2689 IS tis; 2690 2691 ierr = MatGetLocalSize(pcbddc->local_mat,&nl,NULL);CHKERRQ(ierr); 2692 ierr = ISCreateStride(PETSC_COMM_SELF,nl,0,1,&tis);CHKERRQ(ierr); 2693 ierr = ISLocalToGlobalMappingCreateIS(tis,&l2g);CHKERRQ(ierr); 2694 ierr = ISDestroy(&tis);CHKERRQ(ierr); 2695 } 2696 ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,is[b],&t_zerodiag_subs);CHKERRQ(ierr); 2697 ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr); 2698 if (nl) { 2699 PetscBool valid = PETSC_TRUE; 2700 2701 if (checkb) { 2702 ierr = VecSet(matis->x,0);CHKERRQ(ierr); 2703 ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr); 2704 ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr); 2705 ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr); 2706 for (j=0;j<nl;j++) array[idxs[j]] = 1.; 2707 ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr); 2708 ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr); 2709 ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr); 2710 ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr); 2711 ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr); 2712 ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr); 2713 for (j=0;j<n_interior_dofs;j++) { 2714 if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) { 2715 valid = PETSC_FALSE; 2716 break; 2717 } 2718 } 2719 ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr); 2720 } 2721 if (valid && nneu) { 2722 const PetscInt *idxs; 2723 PetscInt nzb; 2724 2725 ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr); 2726 ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr); 2727 ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr); 2728 if (nzb) valid = PETSC_FALSE; 2729 } 2730 if (valid && pressures) { 2731 IS t_pressure_subs,tmp; 2732 PetscInt i1,i2; 2733 2734 ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr); 2735 ierr = ISEmbed(t_zerodiag_subs,t_pressure_subs,PETSC_TRUE,&tmp);CHKERRQ(ierr); 2736 ierr = ISGetLocalSize(tmp,&i1);CHKERRQ(ierr); 2737 ierr = ISGetLocalSize(t_zerodiag_subs,&i2);CHKERRQ(ierr); 2738 if (i2 != i1) valid = PETSC_FALSE; 2739 ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr); 2740 ierr = ISDestroy(&tmp);CHKERRQ(ierr); 2741 } 2742 if (valid) { 2743 ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[benign_n]);CHKERRQ(ierr); 2744 benign_n++; 2745 } else recompute_zerodiag = PETSC_TRUE; 2746 } 2747 ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr); 2748 ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr); 2749 } 2750 } 2751 } else { /* there's just one subdomain (or zero if they have not been detected */ 2752 PetscBool valid = PETSC_TRUE; 2753 2754 if (nneu) valid = PETSC_FALSE; 2755 if (valid && pressures) { 2756 ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr); 2757 } 2758 if (valid && checkb) { 2759 ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr); 2760 ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr); 2761 ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr); 2762 for (j=0;j<n_interior_dofs;j++) { 2763 if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) { 2764 valid = PETSC_FALSE; 2765 break; 2766 } 2767 } 2768 ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr); 2769 } 2770 if (valid) { 2771 benign_n = 1; 2772 ierr = PetscMalloc1(benign_n,&zerodiag_subs);CHKERRQ(ierr); 2773 ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr); 2774 zerodiag_subs[0] = zerodiag; 2775 } 2776 } 2777 if (checkb) { 2778 ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr); 2779 } 2780 } 2781 ierr = PetscFree(interior_dofs);CHKERRQ(ierr); 2782 2783 if (!benign_n) { 2784 PetscInt n; 2785 2786 ierr = ISDestroy(&zerodiag);CHKERRQ(ierr); 2787 recompute_zerodiag = PETSC_FALSE; 2788 ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr); 2789 if (n) have_null = PETSC_FALSE; 2790 } 2791 2792 /* final check for null pressures */ 2793 if (zerodiag && pressures) { 2794 ierr = ISEqual(pressures,zerodiag,&have_null);CHKERRQ(ierr); 2795 } 2796 2797 if (recompute_zerodiag) { 2798 ierr = ISDestroy(&zerodiag);CHKERRQ(ierr); 2799 if (benign_n == 1) { 2800 ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr); 2801 zerodiag = zerodiag_subs[0]; 2802 } else { 2803 PetscInt i,nzn,*new_idxs; 2804 2805 nzn = 0; 2806 for (i=0;i<benign_n;i++) { 2807 PetscInt ns; 2808 ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr); 2809 nzn += ns; 2810 } 2811 ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr); 2812 nzn = 0; 2813 for (i=0;i<benign_n;i++) { 2814 PetscInt ns,*idxs; 2815 ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr); 2816 ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr); 2817 ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr); 2818 ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr); 2819 nzn += ns; 2820 } 2821 ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr); 2822 ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr); 2823 } 2824 have_null = PETSC_FALSE; 2825 } 2826 2827 /* determines if the coarse solver will be singular or not */ 2828 ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr); 2829 2830 /* Prepare matrix to compute no-net-flux */ 2831 if (pcbddc->compute_nonetflux && !pcbddc->divudotp) { 2832 Mat A,loc_divudotp; 2833 ISLocalToGlobalMapping rl2g,cl2g,l2gmap; 2834 IS row,col,isused = NULL; 2835 PetscInt M,N,n,st,n_isused; 2836 2837 if (pressures) { 2838 isused = pressures; 2839 } else { 2840 isused = zerodiag_save; 2841 } 2842 ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr); 2843 ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr); 2844 ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr); 2845 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"); 2846 n_isused = 0; 2847 if (isused) { 2848 ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr); 2849 } 2850 ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr); 2851 st = st-n_isused; 2852 if (n) { 2853 const PetscInt *gidxs; 2854 2855 ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr); 2856 ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr); 2857 /* TODO: extend ISCreateStride with st = PETSC_DECIDE */ 2858 ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr); 2859 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr); 2860 ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr); 2861 } else { 2862 ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr); 2863 ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr); 2864 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr); 2865 } 2866 ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr); 2867 ierr = ISGetSize(row,&M);CHKERRQ(ierr); 2868 ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr); 2869 ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr); 2870 ierr = ISDestroy(&row);CHKERRQ(ierr); 2871 ierr = ISDestroy(&col);CHKERRQ(ierr); 2872 ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr); 2873 ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr); 2874 ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr); 2875 ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr); 2876 ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr); 2877 ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr); 2878 ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr); 2879 ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr); 2880 ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2881 ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2882 } 2883 ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr); 2884 ierr = ISDestroy(&pressures);CHKERRQ(ierr); 2885 if (bzerodiag) { 2886 PetscInt i; 2887 2888 for (i=0;i<bsp;i++) { 2889 ierr = ISDestroy(&bzerodiag[i]);CHKERRQ(ierr); 2890 } 2891 ierr = PetscFree(bzerodiag);CHKERRQ(ierr); 2892 } 2893 pcbddc->benign_n = benign_n; 2894 pcbddc->benign_zerodiag_subs = zerodiag_subs; 2895 2896 /* determines if the problem has subdomains with 0 pressure block */ 2897 have_null = (PetscBool)(!!pcbddc->benign_n); 2898 ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr); 2899 2900 project_b0: 2901 ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr); 2902 /* change of basis and p0 dofs */ 2903 if (pcbddc->benign_n) { 2904 PetscInt i,s,*nnz; 2905 2906 /* local change of basis for pressures */ 2907 ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr); 2908 ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr); 2909 ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr); 2910 ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr); 2911 ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr); 2912 for (i=0;i<n;i++) nnz[i] = 1; /* defaults to identity */ 2913 for (i=0;i<pcbddc->benign_n;i++) { 2914 const PetscInt *idxs; 2915 PetscInt nzs,j; 2916 2917 ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nzs);CHKERRQ(ierr); 2918 ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr); 2919 for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */ 2920 nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */ 2921 ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr); 2922 } 2923 ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr); 2924 ierr = MatSetOption(pcbddc->benign_change,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr); 2925 ierr = PetscFree(nnz);CHKERRQ(ierr); 2926 /* set identity by default */ 2927 for (i=0;i<n;i++) { 2928 ierr = MatSetValue(pcbddc->benign_change,i,i,1.,INSERT_VALUES);CHKERRQ(ierr); 2929 } 2930 ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr); 2931 ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr); 2932 /* set change on pressures */ 2933 for (s=0;s<pcbddc->benign_n;s++) { 2934 PetscScalar *array; 2935 const PetscInt *idxs; 2936 PetscInt nzs; 2937 2938 ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[s],&nzs);CHKERRQ(ierr); 2939 ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr); 2940 for (i=0;i<nzs-1;i++) { 2941 PetscScalar vals[2]; 2942 PetscInt cols[2]; 2943 2944 cols[0] = idxs[i]; 2945 cols[1] = idxs[nzs-1]; 2946 vals[0] = 1.; 2947 vals[1] = 1.; 2948 ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr); 2949 } 2950 ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr); 2951 for (i=0;i<nzs-1;i++) array[i] = -1.; 2952 array[nzs-1] = 1.; 2953 ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr); 2954 /* store local idxs for p0 */ 2955 pcbddc->benign_p0_lidx[s] = idxs[nzs-1]; 2956 ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr); 2957 ierr = PetscFree(array);CHKERRQ(ierr); 2958 } 2959 ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2960 ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 2961 2962 /* project if needed */ 2963 if (pcbddc->benign_change_explicit) { 2964 Mat M; 2965 2966 ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr); 2967 ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr); 2968 ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr); 2969 ierr = MatDestroy(&M);CHKERRQ(ierr); 2970 } 2971 /* store global idxs for p0 */ 2972 ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr); 2973 } 2974 *zerodiaglocal = zerodiag; 2975 PetscFunctionReturn(0); 2976 } 2977 2978 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get) 2979 { 2980 PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 2981 PetscScalar *array; 2982 PetscErrorCode ierr; 2983 2984 PetscFunctionBegin; 2985 if (!pcbddc->benign_sf) { 2986 ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr); 2987 ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr); 2988 } 2989 if (get) { 2990 ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr); 2991 ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr); 2992 ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr); 2993 ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr); 2994 } else { 2995 ierr = VecGetArray(v,&array);CHKERRQ(ierr); 2996 ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr); 2997 ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr); 2998 ierr = VecRestoreArray(v,&array);CHKERRQ(ierr); 2999 } 3000 PetscFunctionReturn(0); 3001 } 3002 3003 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop) 3004 { 3005 PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 3006 PetscErrorCode ierr; 3007 3008 PetscFunctionBegin; 3009 /* TODO: add error checking 3010 - avoid nested pop (or push) calls. 3011 - cannot push before pop. 3012 - cannot call this if pcbddc->local_mat is NULL 3013 */ 3014 if (!pcbddc->benign_n) { 3015 PetscFunctionReturn(0); 3016 } 3017 if (pop) { 3018 if (pcbddc->benign_change_explicit) { 3019 IS is_p0; 3020 MatReuse reuse; 3021 3022 /* extract B_0 */ 3023 reuse = MAT_INITIAL_MATRIX; 3024 if (pcbddc->benign_B0) { 3025 reuse = MAT_REUSE_MATRIX; 3026 } 3027 ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr); 3028 ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr); 3029 /* remove rows and cols from local problem */ 3030 ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr); 3031 ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr); 3032 ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr); 3033 ierr = ISDestroy(&is_p0);CHKERRQ(ierr); 3034 } else { 3035 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 3036 PetscScalar *vals; 3037 PetscInt i,n,*idxs_ins; 3038 3039 ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr); 3040 ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr); 3041 if (!pcbddc->benign_B0) { 3042 PetscInt *nnz; 3043 ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr); 3044 ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr); 3045 ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr); 3046 ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr); 3047 for (i=0;i<pcbddc->benign_n;i++) { 3048 ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr); 3049 nnz[i] = n - nnz[i]; 3050 } 3051 ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr); 3052 ierr = MatSetOption(pcbddc->benign_B0,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr); 3053 ierr = PetscFree(nnz);CHKERRQ(ierr); 3054 } 3055 3056 for (i=0;i<pcbddc->benign_n;i++) { 3057 PetscScalar *array; 3058 PetscInt *idxs,j,nz,cum; 3059 3060 ierr = VecSet(matis->x,0.);CHKERRQ(ierr); 3061 ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr); 3062 ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr); 3063 for (j=0;j<nz;j++) vals[j] = 1.; 3064 ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr); 3065 ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr); 3066 ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr); 3067 ierr = VecSet(matis->y,0.);CHKERRQ(ierr); 3068 ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr); 3069 ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr); 3070 cum = 0; 3071 for (j=0;j<n;j++) { 3072 if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) { 3073 vals[cum] = array[j]; 3074 idxs_ins[cum] = j; 3075 cum++; 3076 } 3077 } 3078 ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr); 3079 ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr); 3080 ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr); 3081 } 3082 ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3083 ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3084 ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr); 3085 } 3086 } else { /* push */ 3087 if (pcbddc->benign_change_explicit) { 3088 PetscInt i; 3089 3090 for (i=0;i<pcbddc->benign_n;i++) { 3091 PetscScalar *B0_vals; 3092 PetscInt *B0_cols,B0_ncol; 3093 3094 ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr); 3095 ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr); 3096 ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr); 3097 ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr); 3098 ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr); 3099 } 3100 ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3101 ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 3102 } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!"); 3103 } 3104 PetscFunctionReturn(0); 3105 } 3106 3107 PetscErrorCode PCBDDCAdaptiveSelection(PC pc) 3108 { 3109 PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 3110 PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs; 3111 PetscBLASInt B_dummyint,B_neigs,B_ierr,B_lwork; 3112 PetscBLASInt *B_iwork,*B_ifail; 3113 PetscScalar *work,lwork; 3114 PetscScalar *St,*S,*eigv; 3115 PetscScalar *Sarray,*Starray; 3116 PetscReal *eigs,thresh,lthresh,uthresh; 3117 PetscInt i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs; 3118 PetscBool allocated_S_St; 3119 #if defined(PETSC_USE_COMPLEX) 3120 PetscReal *rwork; 3121 #endif 3122 PetscErrorCode ierr; 3123 3124 PetscFunctionBegin; 3125 if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data"); 3126 if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO"); 3127 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); 3128 ierr = PetscLogEventBegin(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr); 3129 3130 if (pcbddc->dbg_flag) { 3131 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 3132 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr); 3133 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr); 3134 ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr); 3135 } 3136 3137 if (pcbddc->dbg_flag) { 3138 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); 3139 } 3140 3141 /* max size of subsets */ 3142 mss = 0; 3143 for (i=0;i<sub_schurs->n_subs;i++) { 3144 PetscInt subset_size; 3145 3146 ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr); 3147 mss = PetscMax(mss,subset_size); 3148 } 3149 3150 /* min/max and threshold */ 3151 nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss; 3152 nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0; 3153 nmax = PetscMax(nmin,nmax); 3154 allocated_S_St = PETSC_FALSE; 3155 if (nmin || !sub_schurs->is_posdef) { /* XXX */ 3156 allocated_S_St = PETSC_TRUE; 3157 } 3158 3159 /* allocate lapack workspace */ 3160 cum = cum2 = 0; 3161 maxneigs = 0; 3162 for (i=0;i<sub_schurs->n_subs;i++) { 3163 PetscInt n,subset_size; 3164 3165 ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr); 3166 n = PetscMin(subset_size,nmax); 3167 cum += subset_size; 3168 cum2 += subset_size*n; 3169 maxneigs = PetscMax(maxneigs,n); 3170 } 3171 if (mss) { 3172 if (sub_schurs->is_symmetric) { 3173 PetscBLASInt B_itype = 1; 3174 PetscBLASInt B_N = mss; 3175 PetscReal zero = 0.0; 3176 PetscReal eps = 0.0; /* dlamch? */ 3177 3178 B_lwork = -1; 3179 S = NULL; 3180 St = NULL; 3181 eigs = NULL; 3182 eigv = NULL; 3183 B_iwork = NULL; 3184 B_ifail = NULL; 3185 #if defined(PETSC_USE_COMPLEX) 3186 rwork = NULL; 3187 #endif 3188 thresh = 1.0; 3189 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 3190 #if defined(PETSC_USE_COMPLEX) 3191 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)); 3192 #else 3193 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)); 3194 #endif 3195 if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr); 3196 ierr = PetscFPTrapPop();CHKERRQ(ierr); 3197 } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented"); 3198 } else { 3199 lwork = 0; 3200 } 3201 3202 nv = 0; 3203 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) */ 3204 ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr); 3205 } 3206 ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr); 3207 if (allocated_S_St) { 3208 ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr); 3209 } 3210 ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr); 3211 #if defined(PETSC_USE_COMPLEX) 3212 ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr); 3213 #endif 3214 ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n, 3215 nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr, 3216 nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr, 3217 nv+cum,&pcbddc->adaptive_constraints_idxs, 3218 nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr); 3219 ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr); 3220 3221 maxneigs = 0; 3222 cum = cumarray = 0; 3223 pcbddc->adaptive_constraints_idxs_ptr[0] = 0; 3224 pcbddc->adaptive_constraints_data_ptr[0] = 0; 3225 if (sub_schurs->is_vertices && pcbddc->use_vertices) { 3226 const PetscInt *idxs; 3227 3228 ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr); 3229 for (cum=0;cum<nv;cum++) { 3230 pcbddc->adaptive_constraints_n[cum] = 1; 3231 pcbddc->adaptive_constraints_idxs[cum] = idxs[cum]; 3232 pcbddc->adaptive_constraints_data[cum] = 1.0; 3233 pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1; 3234 pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1; 3235 } 3236 ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr); 3237 } 3238 3239 if (mss) { /* multilevel */ 3240 ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr); 3241 ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr); 3242 } 3243 3244 lthresh = pcbddc->adaptive_threshold[0]; 3245 uthresh = pcbddc->adaptive_threshold[1]; 3246 for (i=0;i<sub_schurs->n_subs;i++) { 3247 const PetscInt *idxs; 3248 PetscReal upper,lower; 3249 PetscInt j,subset_size,eigs_start = 0; 3250 PetscBLASInt B_N; 3251 PetscBool same_data = PETSC_FALSE; 3252 PetscBool scal = PETSC_FALSE; 3253 3254 if (pcbddc->use_deluxe_scaling) { 3255 upper = PETSC_MAX_REAL; 3256 lower = uthresh; 3257 } else { 3258 if (!sub_schurs->is_posdef) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented without deluxe scaling"); 3259 upper = 1./uthresh; 3260 lower = 0.; 3261 } 3262 ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr); 3263 ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr); 3264 ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr); 3265 /* this is experimental: we assume the dofs have been properly grouped to have 3266 the diagonal blocks Schur complements either positive or negative definite (true for Stokes) */ 3267 if (!sub_schurs->is_posdef) { 3268 Mat T; 3269 3270 for (j=0;j<subset_size;j++) { 3271 if (PetscRealPart(*(Sarray+cumarray+j*(subset_size+1))) < 0.0) { 3272 ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Sarray+cumarray,&T);CHKERRQ(ierr); 3273 ierr = MatScale(T,-1.0);CHKERRQ(ierr); 3274 ierr = MatDestroy(&T);CHKERRQ(ierr); 3275 ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Starray+cumarray,&T);CHKERRQ(ierr); 3276 ierr = MatScale(T,-1.0);CHKERRQ(ierr); 3277 ierr = MatDestroy(&T);CHKERRQ(ierr); 3278 if (sub_schurs->change_primal_sub) { 3279 PetscInt nz,k; 3280 const PetscInt *idxs; 3281 3282 ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nz);CHKERRQ(ierr); 3283 ierr = ISGetIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr); 3284 for (k=0;k<nz;k++) { 3285 *( Sarray + cumarray + idxs[k]*(subset_size+1)) *= -1.0; 3286 *(Starray + cumarray + idxs[k]*(subset_size+1)) = 0.0; 3287 } 3288 ierr = ISRestoreIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr); 3289 } 3290 scal = PETSC_TRUE; 3291 break; 3292 } 3293 } 3294 } 3295 3296 if (allocated_S_St) { /* S and S_t should be copied since we could need them later */ 3297 if (sub_schurs->is_symmetric) { 3298 PetscInt j,k; 3299 if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */ 3300 ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3301 ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3302 } 3303 for (j=0;j<subset_size;j++) { 3304 for (k=j;k<subset_size;k++) { 3305 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k]; 3306 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k]; 3307 } 3308 } 3309 } else { 3310 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3311 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3312 } 3313 } else { 3314 S = Sarray + cumarray; 3315 St = Starray + cumarray; 3316 } 3317 /* see if we can save some work */ 3318 if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) { 3319 ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr); 3320 } 3321 3322 if (same_data && !sub_schurs->change) { /* there's no need of constraints here */ 3323 B_neigs = 0; 3324 } else { 3325 if (sub_schurs->is_symmetric) { 3326 PetscBLASInt B_itype = 1; 3327 PetscBLASInt B_IL, B_IU; 3328 PetscReal eps = -1.0; /* dlamch? */ 3329 PetscInt nmin_s; 3330 PetscBool compute_range; 3331 3332 B_neigs = 0; 3333 compute_range = (PetscBool)!same_data; 3334 if (nmin >= subset_size) compute_range = PETSC_FALSE; 3335 3336 if (pcbddc->dbg_flag) { 3337 PetscInt nc = 0; 3338 3339 if (sub_schurs->change_primal_sub) { 3340 ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nc);CHKERRQ(ierr); 3341 } 3342 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); 3343 } 3344 3345 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 3346 if (compute_range) { 3347 3348 /* ask for eigenvalues larger than thresh */ 3349 if (sub_schurs->is_posdef) { 3350 #if defined(PETSC_USE_COMPLEX) 3351 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)); 3352 #else 3353 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)); 3354 #endif 3355 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3356 } else { /* no theory so far, but it works nicely */ 3357 PetscInt recipe = 0,recipe_m = 1; 3358 PetscReal bb[2]; 3359 3360 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe",&recipe,NULL);CHKERRQ(ierr); 3361 switch (recipe) { 3362 case 0: 3363 if (scal) { bb[0] = PETSC_MIN_REAL; bb[1] = lthresh; } 3364 else { bb[0] = uthresh; bb[1] = PETSC_MAX_REAL; } 3365 #if defined(PETSC_USE_COMPLEX) 3366 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)); 3367 #else 3368 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)); 3369 #endif 3370 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3371 break; 3372 case 1: 3373 bb[0] = PETSC_MIN_REAL; bb[1] = lthresh*lthresh; 3374 #if defined(PETSC_USE_COMPLEX) 3375 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)); 3376 #else 3377 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)); 3378 #endif 3379 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3380 if (!scal) { 3381 PetscBLASInt B_neigs2 = 0; 3382 3383 bb[0] = PetscMax(lthresh*lthresh,uthresh); bb[1] = PETSC_MAX_REAL; 3384 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3385 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3386 #if defined(PETSC_USE_COMPLEX) 3387 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)); 3388 #else 3389 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)); 3390 #endif 3391 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3392 B_neigs += B_neigs2; 3393 } 3394 break; 3395 case 2: 3396 if (scal) { 3397 bb[0] = PETSC_MIN_REAL; 3398 bb[1] = 0; 3399 #if defined(PETSC_USE_COMPLEX) 3400 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)); 3401 #else 3402 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)); 3403 #endif 3404 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3405 } else { 3406 PetscBLASInt B_neigs2 = 0; 3407 PetscBool import = PETSC_FALSE; 3408 3409 lthresh = PetscMax(lthresh,0.0); 3410 if (lthresh > 0.0) { 3411 bb[0] = PETSC_MIN_REAL; 3412 bb[1] = lthresh*lthresh; 3413 3414 import = PETSC_TRUE; 3415 #if defined(PETSC_USE_COMPLEX) 3416 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)); 3417 #else 3418 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)); 3419 #endif 3420 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3421 } 3422 bb[0] = PetscMax(lthresh*lthresh,uthresh); 3423 bb[1] = PETSC_MAX_REAL; 3424 if (import) { 3425 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3426 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3427 } 3428 #if defined(PETSC_USE_COMPLEX) 3429 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)); 3430 #else 3431 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)); 3432 #endif 3433 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3434 B_neigs += B_neigs2; 3435 } 3436 break; 3437 case 3: 3438 if (scal) { 3439 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min_scal",&recipe_m,NULL);CHKERRQ(ierr); 3440 } else { 3441 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min",&recipe_m,NULL);CHKERRQ(ierr); 3442 } 3443 if (!scal) { 3444 bb[0] = uthresh; 3445 bb[1] = PETSC_MAX_REAL; 3446 #if defined(PETSC_USE_COMPLEX) 3447 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)); 3448 #else 3449 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)); 3450 #endif 3451 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3452 } 3453 if (recipe_m > 0 && B_N - B_neigs > 0) { 3454 PetscBLASInt B_neigs2 = 0; 3455 3456 B_IL = 1; 3457 ierr = PetscBLASIntCast(PetscMin(recipe_m,B_N - B_neigs),&B_IU);CHKERRQ(ierr); 3458 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3459 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3460 #if defined(PETSC_USE_COMPLEX) 3461 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)); 3462 #else 3463 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)); 3464 #endif 3465 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3466 B_neigs += B_neigs2; 3467 } 3468 break; 3469 case 4: 3470 bb[0] = PETSC_MIN_REAL; bb[1] = lthresh; 3471 #if defined(PETSC_USE_COMPLEX) 3472 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)); 3473 #else 3474 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)); 3475 #endif 3476 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3477 { 3478 PetscBLASInt B_neigs2 = 0; 3479 3480 bb[0] = PetscMax(lthresh+PETSC_SMALL,uthresh); bb[1] = PETSC_MAX_REAL; 3481 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3482 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3483 #if defined(PETSC_USE_COMPLEX) 3484 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)); 3485 #else 3486 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)); 3487 #endif 3488 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3489 B_neigs += B_neigs2; 3490 } 3491 break; 3492 case 5: /* same as before: first compute all eigenvalues, then filter */ 3493 #if defined(PETSC_USE_COMPLEX) 3494 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)); 3495 #else 3496 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)); 3497 #endif 3498 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3499 { 3500 PetscInt e,k,ne; 3501 for (e=0,ne=0;e<B_neigs;e++) { 3502 if (eigs[e] < lthresh || eigs[e] > uthresh) { 3503 for (k=0;k<B_N;k++) S[ne*B_N+k] = eigv[e*B_N+k]; 3504 eigs[ne] = eigs[e]; 3505 ne++; 3506 } 3507 } 3508 ierr = PetscMemcpy(eigv,S,B_N*ne*sizeof(PetscScalar));CHKERRQ(ierr); 3509 B_neigs = ne; 3510 } 3511 break; 3512 default: 3513 SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Unknown recipe %D",recipe); 3514 break; 3515 } 3516 } 3517 } else if (!same_data) { /* this is just to see all the eigenvalues */ 3518 B_IU = PetscMax(1,PetscMin(B_N,nmax)); 3519 B_IL = 1; 3520 #if defined(PETSC_USE_COMPLEX) 3521 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)); 3522 #else 3523 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)); 3524 #endif 3525 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3526 } else { /* same_data is true, so just get the adaptive functional requested by the user */ 3527 PetscInt k; 3528 if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen"); 3529 ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr); 3530 ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr); 3531 nmin = nmax; 3532 ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr); 3533 for (k=0;k<nmax;k++) { 3534 eigs[k] = 1./PETSC_SMALL; 3535 eigv[k*(subset_size+1)] = 1.0; 3536 } 3537 } 3538 ierr = PetscFPTrapPop();CHKERRQ(ierr); 3539 if (B_ierr) { 3540 if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr); 3541 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); 3542 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); 3543 } 3544 3545 if (B_neigs > nmax) { 3546 if (pcbddc->dbg_flag) { 3547 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer," found %d eigs, more than maximum required %D.\n",B_neigs,nmax);CHKERRQ(ierr); 3548 } 3549 if (pcbddc->use_deluxe_scaling) eigs_start = scal ? 0 : B_neigs-nmax; 3550 B_neigs = nmax; 3551 } 3552 3553 nmin_s = PetscMin(nmin,B_N); 3554 if (B_neigs < nmin_s) { 3555 PetscBLASInt B_neigs2 = 0; 3556 3557 if (pcbddc->use_deluxe_scaling) { 3558 if (scal) { 3559 B_IU = nmin_s; 3560 B_IL = B_neigs + 1; 3561 } else { 3562 B_IL = B_N - nmin_s + 1; 3563 B_IU = B_N - B_neigs; 3564 } 3565 } else { 3566 B_IL = B_neigs + 1; 3567 B_IU = nmin_s; 3568 } 3569 if (pcbddc->dbg_flag) { 3570 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); 3571 } 3572 if (sub_schurs->is_symmetric) { 3573 PetscInt j,k; 3574 for (j=0;j<subset_size;j++) { 3575 for (k=j;k<subset_size;k++) { 3576 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k]; 3577 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k]; 3578 } 3579 } 3580 } else { 3581 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3582 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr); 3583 } 3584 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 3585 #if defined(PETSC_USE_COMPLEX) 3586 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)); 3587 #else 3588 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)); 3589 #endif 3590 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr); 3591 ierr = PetscFPTrapPop();CHKERRQ(ierr); 3592 B_neigs += B_neigs2; 3593 } 3594 if (B_ierr) { 3595 if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr); 3596 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); 3597 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); 3598 } 3599 if (pcbddc->dbg_flag) { 3600 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer," -> Got %d eigs\n",B_neigs);CHKERRQ(ierr); 3601 for (j=0;j<B_neigs;j++) { 3602 if (eigs[j] == 0.0) { 3603 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer," Inf\n");CHKERRQ(ierr); 3604 } else { 3605 if (pcbddc->use_deluxe_scaling) { 3606 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer," %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr); 3607 } else { 3608 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer," %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr); 3609 } 3610 } 3611 } 3612 } 3613 } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented"); 3614 } 3615 /* change the basis back to the original one */ 3616 if (sub_schurs->change) { 3617 Mat change,phi,phit; 3618 3619 if (pcbddc->dbg_flag > 2) { 3620 PetscInt ii; 3621 for (ii=0;ii<B_neigs;ii++) { 3622 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer," -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr); 3623 for (j=0;j<B_N;j++) { 3624 #if defined(PETSC_USE_COMPLEX) 3625 PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]); 3626 PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]); 3627 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer," %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr); 3628 #else 3629 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer," %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr); 3630 #endif 3631 } 3632 } 3633 } 3634 ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr); 3635 ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr); 3636 ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr); 3637 ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr); 3638 ierr = MatDestroy(&phit);CHKERRQ(ierr); 3639 ierr = MatDestroy(&phi);CHKERRQ(ierr); 3640 } 3641 maxneigs = PetscMax(B_neigs,maxneigs); 3642 pcbddc->adaptive_constraints_n[i+nv] = B_neigs; 3643 if (B_neigs) { 3644 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); 3645 3646 if (pcbddc->dbg_flag > 1) { 3647 PetscInt ii; 3648 for (ii=0;ii<B_neigs;ii++) { 3649 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer," -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr); 3650 for (j=0;j<B_N;j++) { 3651 #if defined(PETSC_USE_COMPLEX) 3652 PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]); 3653 PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]); 3654 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer," %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr); 3655 #else 3656 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer," %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr); 3657 #endif 3658 } 3659 } 3660 } 3661 ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr); 3662 pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size; 3663 pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs; 3664 cum++; 3665 } 3666 ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr); 3667 /* shift for next computation */ 3668 cumarray += subset_size*subset_size; 3669 } 3670 if (pcbddc->dbg_flag) { 3671 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 3672 } 3673 3674 if (mss) { 3675 ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr); 3676 ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr); 3677 /* destroy matrices (junk) */ 3678 ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr); 3679 ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr); 3680 } 3681 if (allocated_S_St) { 3682 ierr = PetscFree2(S,St);CHKERRQ(ierr); 3683 } 3684 ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr); 3685 #if defined(PETSC_USE_COMPLEX) 3686 ierr = PetscFree(rwork);CHKERRQ(ierr); 3687 #endif 3688 if (pcbddc->dbg_flag) { 3689 PetscInt maxneigs_r; 3690 ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr); 3691 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %D\n",maxneigs_r);CHKERRQ(ierr); 3692 } 3693 ierr = PetscLogEventEnd(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr); 3694 PetscFunctionReturn(0); 3695 } 3696 3697 PetscErrorCode PCBDDCSetUpSolvers(PC pc) 3698 { 3699 PetscScalar *coarse_submat_vals; 3700 PetscErrorCode ierr; 3701 3702 PetscFunctionBegin; 3703 /* Setup local scatters R_to_B and (optionally) R_to_D */ 3704 /* PCBDDCSetUpLocalWorkVectors should be called first! */ 3705 ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr); 3706 3707 /* Setup local neumann solver ksp_R */ 3708 /* PCBDDCSetUpLocalScatters should be called first! */ 3709 ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr); 3710 3711 /* 3712 Setup local correction and local part of coarse basis. 3713 Gives back the dense local part of the coarse matrix in column major ordering 3714 */ 3715 ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr); 3716 3717 /* Compute total number of coarse nodes and setup coarse solver */ 3718 ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr); 3719 3720 /* free */ 3721 ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr); 3722 PetscFunctionReturn(0); 3723 } 3724 3725 PetscErrorCode PCBDDCResetCustomization(PC pc) 3726 { 3727 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 3728 PetscErrorCode ierr; 3729 3730 PetscFunctionBegin; 3731 ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr); 3732 ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr); 3733 ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr); 3734 ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr); 3735 ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr); 3736 ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr); 3737 ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr); 3738 ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr); 3739 ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr); 3740 ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr); 3741 PetscFunctionReturn(0); 3742 } 3743 3744 PetscErrorCode PCBDDCResetTopography(PC pc) 3745 { 3746 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 3747 PetscInt i; 3748 PetscErrorCode ierr; 3749 3750 PetscFunctionBegin; 3751 ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr); 3752 ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr); 3753 ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr); 3754 ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr); 3755 ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr); 3756 ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr); 3757 ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr); 3758 ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr); 3759 ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr); 3760 ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr); 3761 ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr); 3762 for (i=0;i<pcbddc->n_local_subs;i++) { 3763 ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr); 3764 } 3765 pcbddc->n_local_subs = 0; 3766 ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr); 3767 ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr); 3768 pcbddc->graphanalyzed = PETSC_FALSE; 3769 pcbddc->recompute_topography = PETSC_TRUE; 3770 pcbddc->corner_selected = PETSC_FALSE; 3771 PetscFunctionReturn(0); 3772 } 3773 3774 PetscErrorCode PCBDDCResetSolvers(PC pc) 3775 { 3776 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 3777 PetscErrorCode ierr; 3778 3779 PetscFunctionBegin; 3780 ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr); 3781 if (pcbddc->coarse_phi_B) { 3782 PetscScalar *array; 3783 ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr); 3784 ierr = PetscFree(array);CHKERRQ(ierr); 3785 } 3786 ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr); 3787 ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr); 3788 ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr); 3789 ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr); 3790 ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr); 3791 ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr); 3792 ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr); 3793 ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr); 3794 ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr); 3795 ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr); 3796 ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr); 3797 ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr); 3798 ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr); 3799 ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr); 3800 ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr); 3801 ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr); 3802 ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr); 3803 ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr); 3804 ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr); 3805 ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr); 3806 ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr); 3807 ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr); 3808 ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr); 3809 ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr); 3810 ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr); 3811 ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr); 3812 ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr); 3813 if (pcbddc->benign_zerodiag_subs) { 3814 PetscInt i; 3815 for (i=0;i<pcbddc->benign_n;i++) { 3816 ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr); 3817 } 3818 ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr); 3819 } 3820 ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr); 3821 PetscFunctionReturn(0); 3822 } 3823 3824 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc) 3825 { 3826 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 3827 PC_IS *pcis = (PC_IS*)pc->data; 3828 VecType impVecType; 3829 PetscInt n_constraints,n_R,old_size; 3830 PetscErrorCode ierr; 3831 3832 PetscFunctionBegin; 3833 n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices; 3834 n_R = pcis->n - pcbddc->n_vertices; 3835 ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr); 3836 /* local work vectors (try to avoid unneeded work)*/ 3837 /* R nodes */ 3838 old_size = -1; 3839 if (pcbddc->vec1_R) { 3840 ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr); 3841 } 3842 if (n_R != old_size) { 3843 ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr); 3844 ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr); 3845 ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr); 3846 ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr); 3847 ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr); 3848 ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr); 3849 } 3850 /* local primal dofs */ 3851 old_size = -1; 3852 if (pcbddc->vec1_P) { 3853 ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr); 3854 } 3855 if (pcbddc->local_primal_size != old_size) { 3856 ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr); 3857 ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr); 3858 ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr); 3859 ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr); 3860 } 3861 /* local explicit constraints */ 3862 old_size = -1; 3863 if (pcbddc->vec1_C) { 3864 ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr); 3865 } 3866 if (n_constraints && n_constraints != old_size) { 3867 ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr); 3868 ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr); 3869 ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr); 3870 ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr); 3871 } 3872 PetscFunctionReturn(0); 3873 } 3874 3875 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n) 3876 { 3877 PetscErrorCode ierr; 3878 /* pointers to pcis and pcbddc */ 3879 PC_IS* pcis = (PC_IS*)pc->data; 3880 PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 3881 PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs; 3882 /* submatrices of local problem */ 3883 Mat A_RV,A_VR,A_VV,local_auxmat2_R; 3884 /* submatrices of local coarse problem */ 3885 Mat S_VV,S_CV,S_VC,S_CC; 3886 /* working matrices */ 3887 Mat C_CR; 3888 /* additional working stuff */ 3889 PC pc_R; 3890 Mat F,Brhs = NULL; 3891 Vec dummy_vec; 3892 PetscBool isLU,isCHOL,isILU,need_benign_correction,sparserhs; 3893 PetscScalar *coarse_submat_vals; /* TODO: use a PETSc matrix */ 3894 PetscScalar *work; 3895 PetscInt *idx_V_B; 3896 PetscInt lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I; 3897 PetscInt i,n_R,n_D,n_B; 3898 3899 /* some shortcuts to scalars */ 3900 PetscScalar one=1.0,m_one=-1.0; 3901 3902 PetscFunctionBegin; 3903 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"); 3904 ierr = PetscLogEventBegin(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr); 3905 3906 /* Set Non-overlapping dimensions */ 3907 n_vertices = pcbddc->n_vertices; 3908 n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices; 3909 n_B = pcis->n_B; 3910 n_D = pcis->n - n_B; 3911 n_R = pcis->n - n_vertices; 3912 3913 /* vertices in boundary numbering */ 3914 ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr); 3915 ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr); 3916 if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D",n_vertices,i); 3917 3918 /* Subdomain contribution (Non-overlapping) to coarse matrix */ 3919 ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr); 3920 ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr); 3921 ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr); 3922 ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr); 3923 ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr); 3924 ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr); 3925 ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr); 3926 ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr); 3927 ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr); 3928 3929 /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */ 3930 ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr); 3931 ierr = PCSetUp(pc_R);CHKERRQ(ierr); 3932 ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr); 3933 ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr); 3934 ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr); 3935 lda_rhs = n_R; 3936 need_benign_correction = PETSC_FALSE; 3937 if (isLU || isILU || isCHOL) { 3938 ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr); 3939 } else if (sub_schurs && sub_schurs->reuse_solver) { 3940 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 3941 MatFactorType type; 3942 3943 F = reuse_solver->F; 3944 ierr = MatGetFactorType(F,&type);CHKERRQ(ierr); 3945 if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE; 3946 ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr); 3947 need_benign_correction = (PetscBool)(!!reuse_solver->benign_n); 3948 } else { 3949 F = NULL; 3950 } 3951 3952 /* determine if we can use a sparse right-hand side */ 3953 sparserhs = PETSC_FALSE; 3954 if (F) { 3955 MatSolverType solver; 3956 3957 ierr = MatFactorGetSolverType(F,&solver);CHKERRQ(ierr); 3958 ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr); 3959 } 3960 3961 /* allocate workspace */ 3962 n = 0; 3963 if (n_constraints) { 3964 n += lda_rhs*n_constraints; 3965 } 3966 if (n_vertices) { 3967 n = PetscMax(2*lda_rhs*n_vertices,n); 3968 n = PetscMax((lda_rhs+n_B)*n_vertices,n); 3969 } 3970 if (!pcbddc->symmetric_primal) { 3971 n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n); 3972 } 3973 ierr = PetscMalloc1(n,&work);CHKERRQ(ierr); 3974 3975 /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */ 3976 dummy_vec = NULL; 3977 if (need_benign_correction && lda_rhs != n_R && F) { 3978 ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&dummy_vec);CHKERRQ(ierr); 3979 ierr = VecSetSizes(dummy_vec,lda_rhs,PETSC_DECIDE);CHKERRQ(ierr); 3980 ierr = VecSetType(dummy_vec,((PetscObject)pcis->vec1_N)->type_name);CHKERRQ(ierr); 3981 } 3982 3983 /* Precompute stuffs needed for preprocessing and application of BDDC*/ 3984 if (n_constraints) { 3985 Mat M3,C_B; 3986 IS is_aux; 3987 PetscScalar *array,*array2; 3988 3989 ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr); 3990 ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr); 3991 3992 /* Extract constraints on R nodes: C_{CR} */ 3993 ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr); 3994 ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr); 3995 ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr); 3996 3997 /* Assemble local_auxmat2_R = (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */ 3998 /* Assemble pcbddc->local_auxmat2 = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */ 3999 if (!sparserhs) { 4000 ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr); 4001 for (i=0;i<n_constraints;i++) { 4002 const PetscScalar *row_cmat_values; 4003 const PetscInt *row_cmat_indices; 4004 PetscInt size_of_constraint,j; 4005 4006 ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr); 4007 for (j=0;j<size_of_constraint;j++) { 4008 work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j]; 4009 } 4010 ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr); 4011 } 4012 ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr); 4013 } else { 4014 Mat tC_CR; 4015 4016 ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr); 4017 if (lda_rhs != n_R) { 4018 PetscScalar *aa; 4019 PetscInt r,*ii,*jj; 4020 PetscBool done; 4021 4022 ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr); 4023 if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed"); 4024 ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr); 4025 ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr); 4026 ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr); 4027 if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed"); 4028 } else { 4029 ierr = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr); 4030 tC_CR = C_CR; 4031 } 4032 ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr); 4033 ierr = MatDestroy(&tC_CR);CHKERRQ(ierr); 4034 } 4035 ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr); 4036 if (F) { 4037 if (need_benign_correction) { 4038 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 4039 4040 /* rhs is already zero on interior dofs, no need to change the rhs */ 4041 ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr); 4042 } 4043 ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr); 4044 if (need_benign_correction) { 4045 PetscScalar *marr; 4046 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 4047 4048 ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr); 4049 if (lda_rhs != n_R) { 4050 for (i=0;i<n_constraints;i++) { 4051 ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr); 4052 ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr); 4053 ierr = VecResetArray(dummy_vec);CHKERRQ(ierr); 4054 } 4055 } else { 4056 for (i=0;i<n_constraints;i++) { 4057 ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr); 4058 ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr); 4059 ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr); 4060 } 4061 } 4062 ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr); 4063 } 4064 } else { 4065 PetscScalar *marr; 4066 4067 ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr); 4068 for (i=0;i<n_constraints;i++) { 4069 ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr); 4070 ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr); 4071 ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr); 4072 ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr); 4073 ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr); 4074 ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr); 4075 } 4076 ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr); 4077 } 4078 if (sparserhs) { 4079 ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr); 4080 } 4081 ierr = MatDestroy(&Brhs);CHKERRQ(ierr); 4082 if (!pcbddc->switch_static) { 4083 ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr); 4084 ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr); 4085 ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr); 4086 for (i=0;i<n_constraints;i++) { 4087 ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr); 4088 ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr); 4089 ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4090 ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4091 ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr); 4092 ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr); 4093 } 4094 ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr); 4095 ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr); 4096 ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr); 4097 } else { 4098 if (lda_rhs != n_R) { 4099 IS dummy; 4100 4101 ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr); 4102 ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr); 4103 ierr = ISDestroy(&dummy);CHKERRQ(ierr); 4104 } else { 4105 ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr); 4106 pcbddc->local_auxmat2 = local_auxmat2_R; 4107 } 4108 ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr); 4109 } 4110 ierr = ISDestroy(&is_aux);CHKERRQ(ierr); 4111 /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1} */ 4112 ierr = MatScale(M3,m_one);CHKERRQ(ierr); 4113 if (isCHOL) { 4114 ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr); 4115 } else { 4116 ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr); 4117 } 4118 ierr = MatSeqDenseInvertFactors_Private(M3);CHKERRQ(ierr); 4119 /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */ 4120 ierr = MatMatMult(M3,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr); 4121 ierr = MatDestroy(&C_B);CHKERRQ(ierr); 4122 ierr = MatCopy(M3,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */ 4123 ierr = MatDestroy(&M3);CHKERRQ(ierr); 4124 } 4125 4126 /* Get submatrices from subdomain matrix */ 4127 if (n_vertices) { 4128 IS is_aux; 4129 PetscBool isseqaij; 4130 4131 if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */ 4132 IS tis; 4133 4134 ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr); 4135 ierr = ISSort(tis);CHKERRQ(ierr); 4136 ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr); 4137 ierr = ISDestroy(&tis);CHKERRQ(ierr); 4138 } else { 4139 ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr); 4140 } 4141 ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr); 4142 ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr); 4143 ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr); 4144 if (!isseqaij) { /* MatMatMult(A_VR,A_RRmA_RV) below will raise an error */ 4145 ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr); 4146 } 4147 ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr); 4148 ierr = ISDestroy(&is_aux);CHKERRQ(ierr); 4149 } 4150 4151 /* Matrix of coarse basis functions (local) */ 4152 if (pcbddc->coarse_phi_B) { 4153 PetscInt on_B,on_primal,on_D=n_D; 4154 if (pcbddc->coarse_phi_D) { 4155 ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr); 4156 } 4157 ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr); 4158 if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) { 4159 PetscScalar *marray; 4160 4161 ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr); 4162 ierr = PetscFree(marray);CHKERRQ(ierr); 4163 ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr); 4164 ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr); 4165 ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr); 4166 ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr); 4167 } 4168 } 4169 4170 if (!pcbddc->coarse_phi_B) { 4171 PetscScalar *marr; 4172 4173 /* memory size */ 4174 n = n_B*pcbddc->local_primal_size; 4175 if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size; 4176 if (!pcbddc->symmetric_primal) n *= 2; 4177 ierr = PetscCalloc1(n,&marr);CHKERRQ(ierr); 4178 ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr); 4179 marr += n_B*pcbddc->local_primal_size; 4180 if (pcbddc->switch_static || pcbddc->dbg_flag) { 4181 ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr); 4182 marr += n_D*pcbddc->local_primal_size; 4183 } 4184 if (!pcbddc->symmetric_primal) { 4185 ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr); 4186 marr += n_B*pcbddc->local_primal_size; 4187 if (pcbddc->switch_static || pcbddc->dbg_flag) { 4188 ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr); 4189 } 4190 } else { 4191 ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr); 4192 pcbddc->coarse_psi_B = pcbddc->coarse_phi_B; 4193 if (pcbddc->switch_static || pcbddc->dbg_flag) { 4194 ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr); 4195 pcbddc->coarse_psi_D = pcbddc->coarse_phi_D; 4196 } 4197 } 4198 } 4199 4200 /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */ 4201 p0_lidx_I = NULL; 4202 if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) { 4203 const PetscInt *idxs; 4204 4205 ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr); 4206 ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr); 4207 for (i=0;i<pcbddc->benign_n;i++) { 4208 ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr); 4209 } 4210 ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr); 4211 } 4212 4213 /* vertices */ 4214 if (n_vertices) { 4215 PetscBool restoreavr = PETSC_FALSE; 4216 4217 ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr); 4218 4219 if (n_R) { 4220 Mat A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */ 4221 PetscBLASInt B_N,B_one = 1; 4222 const PetscScalar *x; 4223 PetscScalar *y; 4224 4225 ierr = MatScale(A_RV,m_one);CHKERRQ(ierr); 4226 if (need_benign_correction) { 4227 ISLocalToGlobalMapping RtoN; 4228 IS is_p0; 4229 PetscInt *idxs_p0,n; 4230 4231 ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr); 4232 ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr); 4233 ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr); 4234 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); 4235 ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr); 4236 ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr); 4237 ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr); 4238 ierr = ISDestroy(&is_p0);CHKERRQ(ierr); 4239 } 4240 4241 ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr); 4242 if (!sparserhs || need_benign_correction) { 4243 if (lda_rhs == n_R) { 4244 ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr); 4245 } else { 4246 PetscScalar *av,*array; 4247 const PetscInt *xadj,*adjncy; 4248 PetscInt n; 4249 PetscBool flg_row; 4250 4251 array = work+lda_rhs*n_vertices; 4252 ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr); 4253 ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr); 4254 ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr); 4255 ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr); 4256 for (i=0;i<n;i++) { 4257 PetscInt j; 4258 for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j]; 4259 } 4260 ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr); 4261 ierr = MatDestroy(&A_RV);CHKERRQ(ierr); 4262 ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr); 4263 } 4264 if (need_benign_correction) { 4265 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 4266 PetscScalar *marr; 4267 4268 ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr); 4269 /* need \Phi^T A_RV = (I+L)A_RV, L given by 4270 4271 | 0 0 0 | (V) 4272 L = | 0 0 -1 | (P-p0) 4273 | 0 0 -1 | (p0) 4274 4275 */ 4276 for (i=0;i<reuse_solver->benign_n;i++) { 4277 const PetscScalar *vals; 4278 const PetscInt *idxs,*idxs_zero; 4279 PetscInt n,j,nz; 4280 4281 ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr); 4282 ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr); 4283 ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr); 4284 for (j=0;j<n;j++) { 4285 PetscScalar val = vals[j]; 4286 PetscInt k,col = idxs[j]; 4287 for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val; 4288 } 4289 ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr); 4290 ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr); 4291 } 4292 ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr); 4293 } 4294 ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr); 4295 Brhs = A_RV; 4296 } else { 4297 Mat tA_RVT,A_RVT; 4298 4299 if (!pcbddc->symmetric_primal) { 4300 /* A_RV already scaled by -1 */ 4301 ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr); 4302 } else { 4303 restoreavr = PETSC_TRUE; 4304 ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr); 4305 ierr = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr); 4306 A_RVT = A_VR; 4307 } 4308 if (lda_rhs != n_R) { 4309 PetscScalar *aa; 4310 PetscInt r,*ii,*jj; 4311 PetscBool done; 4312 4313 ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr); 4314 if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed"); 4315 ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr); 4316 ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr); 4317 ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr); 4318 if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed"); 4319 } else { 4320 ierr = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr); 4321 tA_RVT = A_RVT; 4322 } 4323 ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr); 4324 ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr); 4325 ierr = MatDestroy(&A_RVT);CHKERRQ(ierr); 4326 } 4327 if (F) { 4328 /* need to correct the rhs */ 4329 if (need_benign_correction) { 4330 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 4331 PetscScalar *marr; 4332 4333 ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr); 4334 if (lda_rhs != n_R) { 4335 for (i=0;i<n_vertices;i++) { 4336 ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr); 4337 ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr); 4338 ierr = VecResetArray(dummy_vec);CHKERRQ(ierr); 4339 } 4340 } else { 4341 for (i=0;i<n_vertices;i++) { 4342 ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr); 4343 ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr); 4344 ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr); 4345 } 4346 } 4347 ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr); 4348 } 4349 ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr); 4350 if (restoreavr) { 4351 ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr); 4352 } 4353 /* need to correct the solution */ 4354 if (need_benign_correction) { 4355 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 4356 PetscScalar *marr; 4357 4358 ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr); 4359 if (lda_rhs != n_R) { 4360 for (i=0;i<n_vertices;i++) { 4361 ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr); 4362 ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr); 4363 ierr = VecResetArray(dummy_vec);CHKERRQ(ierr); 4364 } 4365 } else { 4366 for (i=0;i<n_vertices;i++) { 4367 ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr); 4368 ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr); 4369 ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr); 4370 } 4371 } 4372 ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr); 4373 } 4374 } else { 4375 ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr); 4376 for (i=0;i<n_vertices;i++) { 4377 ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr); 4378 ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr); 4379 ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr); 4380 ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr); 4381 ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr); 4382 ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr); 4383 } 4384 ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr); 4385 } 4386 ierr = MatDestroy(&A_RV);CHKERRQ(ierr); 4387 ierr = MatDestroy(&Brhs);CHKERRQ(ierr); 4388 /* S_VV and S_CV */ 4389 if (n_constraints) { 4390 Mat B; 4391 4392 ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr); 4393 for (i=0;i<n_vertices;i++) { 4394 ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr); 4395 ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr); 4396 ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4397 ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4398 ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr); 4399 ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr); 4400 } 4401 ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr); 4402 ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr); 4403 ierr = MatDestroy(&B);CHKERRQ(ierr); 4404 ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr); 4405 ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr); 4406 ierr = MatScale(S_CV,m_one);CHKERRQ(ierr); 4407 ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr); 4408 PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one)); 4409 ierr = MatDestroy(&B);CHKERRQ(ierr); 4410 } 4411 if (lda_rhs != n_R) { 4412 ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr); 4413 ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr); 4414 ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr); 4415 } 4416 ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr); 4417 /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */ 4418 if (need_benign_correction) { 4419 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 4420 PetscScalar *marr,*sums; 4421 4422 ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr); 4423 ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr); 4424 for (i=0;i<reuse_solver->benign_n;i++) { 4425 const PetscScalar *vals; 4426 const PetscInt *idxs,*idxs_zero; 4427 PetscInt n,j,nz; 4428 4429 ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr); 4430 ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr); 4431 for (j=0;j<n_vertices;j++) { 4432 PetscInt k; 4433 sums[j] = 0.; 4434 for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs]; 4435 } 4436 ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr); 4437 for (j=0;j<n;j++) { 4438 PetscScalar val = vals[j]; 4439 PetscInt k; 4440 for (k=0;k<n_vertices;k++) { 4441 marr[idxs[j]+k*n_vertices] += val*sums[k]; 4442 } 4443 } 4444 ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr); 4445 ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr); 4446 } 4447 ierr = PetscFree(sums);CHKERRQ(ierr); 4448 ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr); 4449 ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr); 4450 } 4451 ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr); 4452 ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr); 4453 ierr = MatDenseGetArrayRead(A_VV,&x);CHKERRQ(ierr); 4454 ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr); 4455 PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one)); 4456 ierr = MatDenseRestoreArrayRead(A_VV,&x);CHKERRQ(ierr); 4457 ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr); 4458 ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr); 4459 ierr = MatDestroy(&S_VVt);CHKERRQ(ierr); 4460 } else { 4461 ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr); 4462 } 4463 ierr = MatDestroy(&A_VV);CHKERRQ(ierr); 4464 4465 /* coarse basis functions */ 4466 for (i=0;i<n_vertices;i++) { 4467 PetscScalar *y; 4468 4469 ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr); 4470 ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr); 4471 ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr); 4472 ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4473 ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4474 y[n_B*i+idx_V_B[i]] = 1.0; 4475 ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr); 4476 ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr); 4477 4478 if (pcbddc->switch_static || pcbddc->dbg_flag) { 4479 PetscInt j; 4480 4481 ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr); 4482 ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr); 4483 ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4484 ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4485 ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr); 4486 for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0; 4487 ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr); 4488 } 4489 ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr); 4490 } 4491 /* if n_R == 0 the object is not destroyed */ 4492 ierr = MatDestroy(&A_RV);CHKERRQ(ierr); 4493 } 4494 ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr); 4495 4496 if (n_constraints) { 4497 Mat B; 4498 4499 ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr); 4500 ierr = MatScale(S_CC,m_one);CHKERRQ(ierr); 4501 ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr); 4502 ierr = MatScale(S_CC,m_one);CHKERRQ(ierr); 4503 if (n_vertices) { 4504 if (isCHOL || need_benign_correction) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */ 4505 ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr); 4506 } else { 4507 Mat S_VCt; 4508 4509 if (lda_rhs != n_R) { 4510 ierr = MatDestroy(&B);CHKERRQ(ierr); 4511 ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr); 4512 ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr); 4513 } 4514 ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr); 4515 ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); 4516 ierr = MatDestroy(&S_VCt);CHKERRQ(ierr); 4517 } 4518 } 4519 ierr = MatDestroy(&B);CHKERRQ(ierr); 4520 /* coarse basis functions */ 4521 for (i=0;i<n_constraints;i++) { 4522 PetscScalar *y; 4523 4524 ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr); 4525 ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr); 4526 ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr); 4527 ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4528 ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4529 ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr); 4530 ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr); 4531 if (pcbddc->switch_static || pcbddc->dbg_flag) { 4532 PetscInt j; 4533 4534 ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr); 4535 ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr); 4536 ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4537 ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4538 ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr); 4539 for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0; 4540 ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr); 4541 } 4542 ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr); 4543 } 4544 } 4545 if (n_constraints) { 4546 ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr); 4547 } 4548 ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr); 4549 4550 /* coarse matrix entries relative to B_0 */ 4551 if (pcbddc->benign_n) { 4552 Mat B0_B,B0_BPHI; 4553 IS is_dummy; 4554 const PetscScalar *data; 4555 PetscInt j; 4556 4557 ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr); 4558 ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr); 4559 ierr = ISDestroy(&is_dummy);CHKERRQ(ierr); 4560 ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr); 4561 ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr); 4562 ierr = MatDenseGetArrayRead(B0_BPHI,&data);CHKERRQ(ierr); 4563 for (j=0;j<pcbddc->benign_n;j++) { 4564 PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j; 4565 for (i=0;i<pcbddc->local_primal_size;i++) { 4566 coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j]; 4567 coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j]; 4568 } 4569 } 4570 ierr = MatDenseRestoreArrayRead(B0_BPHI,&data);CHKERRQ(ierr); 4571 ierr = MatDestroy(&B0_B);CHKERRQ(ierr); 4572 ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr); 4573 } 4574 4575 /* compute other basis functions for non-symmetric problems */ 4576 if (!pcbddc->symmetric_primal) { 4577 Mat B_V=NULL,B_C=NULL; 4578 PetscScalar *marray; 4579 4580 if (n_constraints) { 4581 Mat S_CCT,C_CRT; 4582 4583 ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr); 4584 ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr); 4585 ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr); 4586 ierr = MatDestroy(&S_CCT);CHKERRQ(ierr); 4587 if (n_vertices) { 4588 Mat S_VCT; 4589 4590 ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr); 4591 ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr); 4592 ierr = MatDestroy(&S_VCT);CHKERRQ(ierr); 4593 } 4594 ierr = MatDestroy(&C_CRT);CHKERRQ(ierr); 4595 } else { 4596 ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr); 4597 } 4598 if (n_vertices && n_R) { 4599 PetscScalar *av,*marray; 4600 const PetscInt *xadj,*adjncy; 4601 PetscInt n; 4602 PetscBool flg_row; 4603 4604 /* B_V = B_V - A_VR^T */ 4605 ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr); 4606 ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr); 4607 ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr); 4608 ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr); 4609 for (i=0;i<n;i++) { 4610 PetscInt j; 4611 for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j]; 4612 } 4613 ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr); 4614 ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr); 4615 ierr = MatDestroy(&A_VR);CHKERRQ(ierr); 4616 } 4617 4618 /* currently there's no support for MatTransposeMatSolve(F,B,X) */ 4619 if (n_vertices) { 4620 ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr); 4621 for (i=0;i<n_vertices;i++) { 4622 ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr); 4623 ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr); 4624 ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr); 4625 ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr); 4626 ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr); 4627 ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr); 4628 } 4629 ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr); 4630 } 4631 if (B_C) { 4632 ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr); 4633 for (i=n_vertices;i<n_constraints+n_vertices;i++) { 4634 ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr); 4635 ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr); 4636 ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr); 4637 ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr); 4638 ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr); 4639 ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr); 4640 } 4641 ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr); 4642 } 4643 /* coarse basis functions */ 4644 for (i=0;i<pcbddc->local_primal_size;i++) { 4645 PetscScalar *y; 4646 4647 ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr); 4648 ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr); 4649 ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr); 4650 ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4651 ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4652 if (i<n_vertices) { 4653 y[n_B*i+idx_V_B[i]] = 1.0; 4654 } 4655 ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr); 4656 ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr); 4657 4658 if (pcbddc->switch_static || pcbddc->dbg_flag) { 4659 ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr); 4660 ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr); 4661 ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4662 ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 4663 ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr); 4664 ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr); 4665 } 4666 ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr); 4667 } 4668 ierr = MatDestroy(&B_V);CHKERRQ(ierr); 4669 ierr = MatDestroy(&B_C);CHKERRQ(ierr); 4670 } 4671 4672 /* free memory */ 4673 ierr = PetscFree(idx_V_B);CHKERRQ(ierr); 4674 ierr = MatDestroy(&S_VV);CHKERRQ(ierr); 4675 ierr = MatDestroy(&S_CV);CHKERRQ(ierr); 4676 ierr = MatDestroy(&S_VC);CHKERRQ(ierr); 4677 ierr = MatDestroy(&S_CC);CHKERRQ(ierr); 4678 ierr = PetscFree(work);CHKERRQ(ierr); 4679 if (n_vertices) { 4680 ierr = MatDestroy(&A_VR);CHKERRQ(ierr); 4681 } 4682 if (n_constraints) { 4683 ierr = MatDestroy(&C_CR);CHKERRQ(ierr); 4684 } 4685 /* Checking coarse_sub_mat and coarse basis functios */ 4686 /* Symmetric case : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */ 4687 /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */ 4688 if (pcbddc->dbg_flag) { 4689 Mat coarse_sub_mat; 4690 Mat AUXMAT,TM1,TM2,TM3,TM4; 4691 Mat coarse_phi_D,coarse_phi_B; 4692 Mat coarse_psi_D,coarse_psi_B; 4693 Mat A_II,A_BB,A_IB,A_BI; 4694 Mat C_B,CPHI; 4695 IS is_dummy; 4696 Vec mones; 4697 MatType checkmattype=MATSEQAIJ; 4698 PetscReal real_value; 4699 4700 if (pcbddc->benign_n && !pcbddc->benign_change_explicit) { 4701 Mat A; 4702 ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr); 4703 ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr); 4704 ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr); 4705 ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr); 4706 ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr); 4707 ierr = MatDestroy(&A);CHKERRQ(ierr); 4708 } else { 4709 ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr); 4710 ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr); 4711 ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr); 4712 ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr); 4713 } 4714 ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr); 4715 ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr); 4716 if (!pcbddc->symmetric_primal) { 4717 ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr); 4718 ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr); 4719 } 4720 ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr); 4721 4722 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr); 4723 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr); 4724 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 4725 if (!pcbddc->symmetric_primal) { 4726 ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr); 4727 ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr); 4728 ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr); 4729 ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr); 4730 ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr); 4731 ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr); 4732 ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr); 4733 ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr); 4734 ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr); 4735 ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr); 4736 ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr); 4737 ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr); 4738 } else { 4739 ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr); 4740 ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr); 4741 ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr); 4742 ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr); 4743 ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr); 4744 ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr); 4745 ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr); 4746 ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr); 4747 } 4748 ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); 4749 ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); 4750 ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); 4751 ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr); 4752 if (pcbddc->benign_n) { 4753 Mat B0_B,B0_BPHI; 4754 const PetscScalar *data2; 4755 PetscScalar *data; 4756 PetscInt j; 4757 4758 ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr); 4759 ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr); 4760 ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr); 4761 ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr); 4762 ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr); 4763 ierr = MatDenseGetArrayRead(B0_BPHI,&data2);CHKERRQ(ierr); 4764 for (j=0;j<pcbddc->benign_n;j++) { 4765 PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j; 4766 for (i=0;i<pcbddc->local_primal_size;i++) { 4767 data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j]; 4768 data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j]; 4769 } 4770 } 4771 ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr); 4772 ierr = MatDenseRestoreArrayRead(B0_BPHI,&data2);CHKERRQ(ierr); 4773 ierr = MatDestroy(&B0_B);CHKERRQ(ierr); 4774 ierr = ISDestroy(&is_dummy);CHKERRQ(ierr); 4775 ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr); 4776 } 4777 #if 0 4778 { 4779 PetscViewer viewer; 4780 char filename[256]; 4781 sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level); 4782 ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr); 4783 ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr); 4784 ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr); 4785 ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr); 4786 ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr); 4787 ierr = MatView(TM1,viewer);CHKERRQ(ierr); 4788 if (pcbddc->coarse_phi_B) { 4789 ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr); 4790 ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr); 4791 } 4792 if (pcbddc->coarse_phi_D) { 4793 ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr); 4794 ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr); 4795 } 4796 if (pcbddc->coarse_psi_B) { 4797 ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr); 4798 ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr); 4799 } 4800 if (pcbddc->coarse_psi_D) { 4801 ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr); 4802 ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr); 4803 } 4804 ierr = PetscObjectSetName((PetscObject)pcbddc->local_mat,"A");CHKERRQ(ierr); 4805 ierr = MatView(pcbddc->local_mat,viewer);CHKERRQ(ierr); 4806 ierr = PetscObjectSetName((PetscObject)pcbddc->ConstraintMatrix,"C");CHKERRQ(ierr); 4807 ierr = MatView(pcbddc->ConstraintMatrix,viewer);CHKERRQ(ierr); 4808 ierr = PetscObjectSetName((PetscObject)pcis->is_I_local,"I");CHKERRQ(ierr); 4809 ierr = ISView(pcis->is_I_local,viewer);CHKERRQ(ierr); 4810 ierr = PetscObjectSetName((PetscObject)pcis->is_B_local,"B");CHKERRQ(ierr); 4811 ierr = ISView(pcis->is_B_local,viewer);CHKERRQ(ierr); 4812 ierr = PetscObjectSetName((PetscObject)pcbddc->is_R_local,"R");CHKERRQ(ierr); 4813 ierr = ISView(pcbddc->is_R_local,viewer);CHKERRQ(ierr); 4814 ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); 4815 } 4816 #endif 4817 ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr); 4818 ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr); 4819 ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr); 4820 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr); 4821 4822 /* check constraints */ 4823 ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr); 4824 ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr); 4825 if (!pcbddc->benign_n) { /* TODO: add benign case */ 4826 ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr); 4827 } else { 4828 PetscScalar *data; 4829 Mat tmat; 4830 ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr); 4831 ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr); 4832 ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr); 4833 ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr); 4834 ierr = MatDestroy(&tmat);CHKERRQ(ierr); 4835 } 4836 ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr); 4837 ierr = VecSet(mones,-1.0);CHKERRQ(ierr); 4838 ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr); 4839 ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr); 4840 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr); 4841 if (!pcbddc->symmetric_primal) { 4842 ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr); 4843 ierr = VecSet(mones,-1.0);CHKERRQ(ierr); 4844 ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr); 4845 ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr); 4846 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr); 4847 } 4848 ierr = MatDestroy(&C_B);CHKERRQ(ierr); 4849 ierr = MatDestroy(&CPHI);CHKERRQ(ierr); 4850 ierr = ISDestroy(&is_dummy);CHKERRQ(ierr); 4851 ierr = VecDestroy(&mones);CHKERRQ(ierr); 4852 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 4853 ierr = MatDestroy(&A_II);CHKERRQ(ierr); 4854 ierr = MatDestroy(&A_BB);CHKERRQ(ierr); 4855 ierr = MatDestroy(&A_IB);CHKERRQ(ierr); 4856 ierr = MatDestroy(&A_BI);CHKERRQ(ierr); 4857 ierr = MatDestroy(&TM1);CHKERRQ(ierr); 4858 ierr = MatDestroy(&TM2);CHKERRQ(ierr); 4859 ierr = MatDestroy(&TM3);CHKERRQ(ierr); 4860 ierr = MatDestroy(&TM4);CHKERRQ(ierr); 4861 ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr); 4862 ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr); 4863 if (!pcbddc->symmetric_primal) { 4864 ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr); 4865 ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr); 4866 } 4867 ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr); 4868 } 4869 /* get back data */ 4870 *coarse_submat_vals_n = coarse_submat_vals; 4871 ierr = PetscLogEventEnd(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr); 4872 PetscFunctionReturn(0); 4873 } 4874 4875 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B) 4876 { 4877 Mat *work_mat; 4878 IS isrow_s,iscol_s; 4879 PetscBool rsorted,csorted; 4880 PetscInt rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL; 4881 PetscErrorCode ierr; 4882 4883 PetscFunctionBegin; 4884 ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr); 4885 ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr); 4886 ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr); 4887 ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr); 4888 4889 if (!rsorted) { 4890 const PetscInt *idxs; 4891 PetscInt *idxs_sorted,i; 4892 4893 ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr); 4894 ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr); 4895 for (i=0;i<rsize;i++) { 4896 idxs_perm_r[i] = i; 4897 } 4898 ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr); 4899 ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr); 4900 for (i=0;i<rsize;i++) { 4901 idxs_sorted[i] = idxs[idxs_perm_r[i]]; 4902 } 4903 ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr); 4904 ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr); 4905 } else { 4906 ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr); 4907 isrow_s = isrow; 4908 } 4909 4910 if (!csorted) { 4911 if (isrow == iscol) { 4912 ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr); 4913 iscol_s = isrow_s; 4914 } else { 4915 const PetscInt *idxs; 4916 PetscInt *idxs_sorted,i; 4917 4918 ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr); 4919 ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr); 4920 for (i=0;i<csize;i++) { 4921 idxs_perm_c[i] = i; 4922 } 4923 ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr); 4924 ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr); 4925 for (i=0;i<csize;i++) { 4926 idxs_sorted[i] = idxs[idxs_perm_c[i]]; 4927 } 4928 ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr); 4929 ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr); 4930 } 4931 } else { 4932 ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr); 4933 iscol_s = iscol; 4934 } 4935 4936 ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr); 4937 4938 if (!rsorted || !csorted) { 4939 Mat new_mat; 4940 IS is_perm_r,is_perm_c; 4941 4942 if (!rsorted) { 4943 PetscInt *idxs_r,i; 4944 ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr); 4945 for (i=0;i<rsize;i++) { 4946 idxs_r[idxs_perm_r[i]] = i; 4947 } 4948 ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr); 4949 ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr); 4950 } else { 4951 ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr); 4952 } 4953 ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr); 4954 4955 if (!csorted) { 4956 if (isrow_s == iscol_s) { 4957 ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr); 4958 is_perm_c = is_perm_r; 4959 } else { 4960 PetscInt *idxs_c,i; 4961 if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present"); 4962 ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr); 4963 for (i=0;i<csize;i++) { 4964 idxs_c[idxs_perm_c[i]] = i; 4965 } 4966 ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr); 4967 ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr); 4968 } 4969 } else { 4970 ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr); 4971 } 4972 ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr); 4973 4974 ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr); 4975 ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr); 4976 work_mat[0] = new_mat; 4977 ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr); 4978 ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr); 4979 } 4980 4981 ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr); 4982 *B = work_mat[0]; 4983 ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr); 4984 ierr = ISDestroy(&isrow_s);CHKERRQ(ierr); 4985 ierr = ISDestroy(&iscol_s);CHKERRQ(ierr); 4986 PetscFunctionReturn(0); 4987 } 4988 4989 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix) 4990 { 4991 Mat_IS* matis = (Mat_IS*)pc->pmat->data; 4992 PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 4993 Mat new_mat,lA; 4994 IS is_local,is_global; 4995 PetscInt local_size; 4996 PetscBool isseqaij; 4997 PetscErrorCode ierr; 4998 4999 PetscFunctionBegin; 5000 ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr); 5001 ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr); 5002 ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr); 5003 ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr); 5004 ierr = ISDestroy(&is_local);CHKERRQ(ierr); 5005 ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr); 5006 ierr = ISDestroy(&is_global);CHKERRQ(ierr); 5007 5008 /* check */ 5009 if (pcbddc->dbg_flag) { 5010 Vec x,x_change; 5011 PetscReal error; 5012 5013 ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr); 5014 ierr = VecSetRandom(x,NULL);CHKERRQ(ierr); 5015 ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr); 5016 ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5017 ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5018 ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr); 5019 if (!pcbddc->change_interior) { 5020 const PetscScalar *x,*y,*v; 5021 PetscReal lerror = 0.; 5022 PetscInt i; 5023 5024 ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr); 5025 ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr); 5026 ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr); 5027 for (i=0;i<local_size;i++) 5028 if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror) 5029 lerror = PetscAbsScalar(x[i]-y[i]); 5030 ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr); 5031 ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr); 5032 ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr); 5033 ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr); 5034 if (error > PETSC_SMALL) { 5035 if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) { 5036 SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e",error); 5037 } else { 5038 SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e",error); 5039 } 5040 } 5041 } 5042 ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5043 ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5044 ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr); 5045 ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr); 5046 if (error > PETSC_SMALL) { 5047 if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) { 5048 SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error); 5049 } else { 5050 SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e",error); 5051 } 5052 } 5053 ierr = VecDestroy(&x);CHKERRQ(ierr); 5054 ierr = VecDestroy(&x_change);CHKERRQ(ierr); 5055 } 5056 5057 /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */ 5058 ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr); 5059 5060 /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */ 5061 ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr); 5062 if (isseqaij) { 5063 ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr); 5064 ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr); 5065 if (lA) { 5066 Mat work; 5067 ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr); 5068 ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr); 5069 ierr = MatDestroy(&work);CHKERRQ(ierr); 5070 } 5071 } else { 5072 Mat work_mat; 5073 5074 ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr); 5075 ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr); 5076 ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr); 5077 ierr = MatDestroy(&work_mat);CHKERRQ(ierr); 5078 if (lA) { 5079 Mat work; 5080 ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr); 5081 ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr); 5082 ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr); 5083 ierr = MatDestroy(&work);CHKERRQ(ierr); 5084 } 5085 } 5086 if (matis->A->symmetric_set) { 5087 ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr); 5088 #if !defined(PETSC_USE_COMPLEX) 5089 ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr); 5090 #endif 5091 } 5092 ierr = MatDestroy(&new_mat);CHKERRQ(ierr); 5093 PetscFunctionReturn(0); 5094 } 5095 5096 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc) 5097 { 5098 PC_IS* pcis = (PC_IS*)(pc->data); 5099 PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 5100 PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs; 5101 PetscInt *idx_R_local=NULL; 5102 PetscInt n_vertices,i,j,n_R,n_D,n_B; 5103 PetscInt vbs,bs; 5104 PetscBT bitmask=NULL; 5105 PetscErrorCode ierr; 5106 5107 PetscFunctionBegin; 5108 /* 5109 No need to setup local scatters if 5110 - primal space is unchanged 5111 AND 5112 - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains) 5113 AND 5114 - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine 5115 */ 5116 if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) { 5117 PetscFunctionReturn(0); 5118 } 5119 /* destroy old objects */ 5120 ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr); 5121 ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr); 5122 ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr); 5123 /* Set Non-overlapping dimensions */ 5124 n_B = pcis->n_B; 5125 n_D = pcis->n - n_B; 5126 n_vertices = pcbddc->n_vertices; 5127 5128 /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */ 5129 5130 /* create auxiliary bitmask and allocate workspace */ 5131 if (!sub_schurs || !sub_schurs->reuse_solver) { 5132 ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr); 5133 ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr); 5134 for (i=0;i<n_vertices;i++) { 5135 ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr); 5136 } 5137 5138 for (i=0, n_R=0; i<pcis->n; i++) { 5139 if (!PetscBTLookup(bitmask,i)) { 5140 idx_R_local[n_R++] = i; 5141 } 5142 } 5143 } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */ 5144 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 5145 5146 ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr); 5147 ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr); 5148 } 5149 5150 /* Block code */ 5151 vbs = 1; 5152 ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr); 5153 if (bs>1 && !(n_vertices%bs)) { 5154 PetscBool is_blocked = PETSC_TRUE; 5155 PetscInt *vary; 5156 if (!sub_schurs || !sub_schurs->reuse_solver) { 5157 ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr); 5158 ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr); 5159 /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */ 5160 /* 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 */ 5161 for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++; 5162 for (i=0; i<pcis->n/bs; i++) { 5163 if (vary[i]!=0 && vary[i]!=bs) { 5164 is_blocked = PETSC_FALSE; 5165 break; 5166 } 5167 } 5168 ierr = PetscFree(vary);CHKERRQ(ierr); 5169 } else { 5170 /* Verify directly the R set */ 5171 for (i=0; i<n_R/bs; i++) { 5172 PetscInt j,node=idx_R_local[bs*i]; 5173 for (j=1; j<bs; j++) { 5174 if (node != idx_R_local[bs*i+j]-j) { 5175 is_blocked = PETSC_FALSE; 5176 break; 5177 } 5178 } 5179 } 5180 } 5181 if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */ 5182 vbs = bs; 5183 for (i=0;i<n_R/vbs;i++) { 5184 idx_R_local[i] = idx_R_local[vbs*i]/vbs; 5185 } 5186 } 5187 } 5188 ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr); 5189 if (sub_schurs && sub_schurs->reuse_solver) { 5190 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 5191 5192 ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr); 5193 ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr); 5194 ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr); 5195 reuse_solver->is_R = pcbddc->is_R_local; 5196 } else { 5197 ierr = PetscFree(idx_R_local);CHKERRQ(ierr); 5198 } 5199 5200 /* print some info if requested */ 5201 if (pcbddc->dbg_flag) { 5202 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr); 5203 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 5204 ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr); 5205 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr); 5206 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %D, dirichlet_size = %D, boundary_size = %D\n",pcis->n,n_D,n_B);CHKERRQ(ierr); 5207 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); 5208 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 5209 } 5210 5211 /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */ 5212 if (!sub_schurs || !sub_schurs->reuse_solver) { 5213 IS is_aux1,is_aux2; 5214 PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local; 5215 5216 ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr); 5217 ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr); 5218 ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr); 5219 ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 5220 for (i=0; i<n_D; i++) { 5221 ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr); 5222 } 5223 ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 5224 for (i=0, j=0; i<n_R; i++) { 5225 if (!PetscBTLookup(bitmask,idx_R_local[i])) { 5226 aux_array1[j++] = i; 5227 } 5228 } 5229 ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr); 5230 ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 5231 for (i=0, j=0; i<n_B; i++) { 5232 if (!PetscBTLookup(bitmask,is_indices[i])) { 5233 aux_array2[j++] = i; 5234 } 5235 } 5236 ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr); 5237 ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr); 5238 ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr); 5239 ierr = ISDestroy(&is_aux1);CHKERRQ(ierr); 5240 ierr = ISDestroy(&is_aux2);CHKERRQ(ierr); 5241 5242 if (pcbddc->switch_static || pcbddc->dbg_flag) { 5243 ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr); 5244 for (i=0, j=0; i<n_R; i++) { 5245 if (PetscBTLookup(bitmask,idx_R_local[i])) { 5246 aux_array1[j++] = i; 5247 } 5248 } 5249 ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr); 5250 ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr); 5251 ierr = ISDestroy(&is_aux1);CHKERRQ(ierr); 5252 } 5253 ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr); 5254 ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr); 5255 } else { 5256 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 5257 IS tis; 5258 PetscInt schur_size; 5259 5260 ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr); 5261 ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr); 5262 ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr); 5263 ierr = ISDestroy(&tis);CHKERRQ(ierr); 5264 if (pcbddc->switch_static || pcbddc->dbg_flag) { 5265 ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr); 5266 ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr); 5267 ierr = ISDestroy(&tis);CHKERRQ(ierr); 5268 } 5269 } 5270 PetscFunctionReturn(0); 5271 } 5272 5273 static PetscErrorCode MatNullSpacePropagate_Private(Mat A, IS is, Mat B) 5274 { 5275 MatNullSpace NullSpace; 5276 Mat dmat; 5277 const Vec *nullvecs; 5278 Vec v,v2,*nullvecs2; 5279 VecScatter sct; 5280 PetscInt k,nnsp_size,bsiz,n,N,bs; 5281 PetscBool nnsp_has_cnst; 5282 PetscErrorCode ierr; 5283 5284 PetscFunctionBegin; 5285 ierr = MatGetNullSpace(B,&NullSpace);CHKERRQ(ierr); 5286 if (!NullSpace) { 5287 ierr = MatGetNearNullSpace(B,&NullSpace);CHKERRQ(ierr); 5288 } 5289 if (NullSpace) PetscFunctionReturn(0); 5290 ierr = MatGetNullSpace(A,&NullSpace);CHKERRQ(ierr); 5291 if (!NullSpace) { 5292 ierr = MatGetNearNullSpace(A,&NullSpace);CHKERRQ(ierr); 5293 } 5294 if (!NullSpace) PetscFunctionReturn(0); 5295 ierr = MatCreateVecs(A,&v,NULL);CHKERRQ(ierr); 5296 ierr = MatCreateVecs(B,&v2,NULL);CHKERRQ(ierr); 5297 ierr = VecScatterCreate(v,is,v2,NULL,&sct);CHKERRQ(ierr); 5298 ierr = MatNullSpaceGetVecs(NullSpace,&nnsp_has_cnst,&nnsp_size,(const Vec**)&nullvecs);CHKERRQ(ierr); 5299 bsiz = nnsp_size+!!nnsp_has_cnst; 5300 ierr = PetscMalloc1(bsiz,&nullvecs2);CHKERRQ(ierr); 5301 ierr = VecGetBlockSize(v2,&bs);CHKERRQ(ierr); 5302 ierr = VecGetSize(v2,&N);CHKERRQ(ierr); 5303 ierr = VecGetLocalSize(v2,&n);CHKERRQ(ierr); 5304 ierr = MatCreateDense(PetscObjectComm((PetscObject)B),n,PETSC_DECIDE,N,bsiz,NULL,&dmat);CHKERRQ(ierr); 5305 for (k=0;k<nnsp_size;k++) { 5306 PetscScalar *arr; 5307 5308 ierr = MatDenseGetColumn(dmat,k,&arr);CHKERRQ(ierr); 5309 ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,arr,&nullvecs2[k]);CHKERRQ(ierr); 5310 ierr = VecScatterBegin(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5311 ierr = VecScatterEnd(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5312 ierr = MatDenseRestoreColumn(dmat,&arr);CHKERRQ(ierr); 5313 } 5314 if (nnsp_has_cnst) { 5315 PetscScalar *arr; 5316 5317 ierr = MatDenseGetColumn(dmat,nnsp_size,&arr);CHKERRQ(ierr); 5318 ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,arr,&nullvecs2[nnsp_size]);CHKERRQ(ierr); 5319 ierr = VecSet(nullvecs2[nnsp_size],1.0);CHKERRQ(ierr); 5320 ierr = MatDenseRestoreColumn(dmat,&arr);CHKERRQ(ierr); 5321 } 5322 ierr = PCBDDCOrthonormalizeVecs(bsiz,nullvecs2);CHKERRQ(ierr); 5323 ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)B),PETSC_FALSE,bsiz,nullvecs2,&NullSpace);CHKERRQ(ierr); 5324 ierr = PetscObjectCompose((PetscObject)NullSpace,"_PBDDC_Null_dmat",(PetscObject)dmat);CHKERRQ(ierr); 5325 ierr = MatDestroy(&dmat);CHKERRQ(ierr); 5326 for (k=0;k<bsiz;k++) { 5327 ierr = VecDestroy(&nullvecs2[k]);CHKERRQ(ierr); 5328 } 5329 ierr = PetscFree(nullvecs2);CHKERRQ(ierr); 5330 ierr = MatSetNearNullSpace(B,NullSpace);CHKERRQ(ierr); 5331 ierr = MatNullSpaceDestroy(&NullSpace);CHKERRQ(ierr); 5332 ierr = VecDestroy(&v);CHKERRQ(ierr); 5333 ierr = VecDestroy(&v2);CHKERRQ(ierr); 5334 ierr = VecScatterDestroy(&sct);CHKERRQ(ierr); 5335 PetscFunctionReturn(0); 5336 } 5337 5338 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann) 5339 { 5340 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 5341 PC_IS *pcis = (PC_IS*)pc->data; 5342 PC pc_temp; 5343 Mat A_RR; 5344 MatNullSpace nnsp; 5345 MatReuse reuse; 5346 PetscScalar m_one = -1.0; 5347 PetscReal value; 5348 PetscInt n_D,n_R; 5349 PetscBool issbaij,opts; 5350 PetscErrorCode ierr; 5351 void (*f)(void) = 0; 5352 char dir_prefix[256],neu_prefix[256],str_level[16]; 5353 size_t len; 5354 5355 PetscFunctionBegin; 5356 ierr = PetscLogEventBegin(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr); 5357 /* compute prefixes */ 5358 ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr); 5359 ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr); 5360 if (!pcbddc->current_level) { 5361 ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,sizeof(dir_prefix));CHKERRQ(ierr); 5362 ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,sizeof(neu_prefix));CHKERRQ(ierr); 5363 ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr); 5364 ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr); 5365 } else { 5366 ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr); 5367 ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr); 5368 len -= 15; /* remove "pc_bddc_coarse_" */ 5369 if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */ 5370 if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */ 5371 /* Nonstandard use of PetscStrncpy() to only copy a portion of the input string */ 5372 ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr); 5373 ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr); 5374 ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr); 5375 ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr); 5376 ierr = PetscStrlcat(dir_prefix,str_level,sizeof(dir_prefix));CHKERRQ(ierr); 5377 ierr = PetscStrlcat(neu_prefix,str_level,sizeof(neu_prefix));CHKERRQ(ierr); 5378 } 5379 5380 /* DIRICHLET PROBLEM */ 5381 if (dirichlet) { 5382 PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs; 5383 if (pcbddc->benign_n && !pcbddc->benign_change_explicit) { 5384 if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented"); 5385 if (pcbddc->dbg_flag) { 5386 Mat A_IIn; 5387 5388 ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr); 5389 ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr); 5390 pcis->A_II = A_IIn; 5391 } 5392 } 5393 if (pcbddc->local_mat->symmetric_set) { 5394 ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr); 5395 } 5396 /* Matrix for Dirichlet problem is pcis->A_II */ 5397 n_D = pcis->n - pcis->n_B; 5398 opts = PETSC_FALSE; 5399 if (!pcbddc->ksp_D) { /* create object if not yet build */ 5400 opts = PETSC_TRUE; 5401 ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr); 5402 ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr); 5403 /* default */ 5404 ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr); 5405 ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr); 5406 ierr = PetscObjectTypeCompare((PetscObject)pcis->pA_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr); 5407 ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr); 5408 if (issbaij) { 5409 ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr); 5410 } else { 5411 ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr); 5412 } 5413 ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_D,pc->erroriffailure);CHKERRQ(ierr); 5414 } 5415 ierr = MatSetOptionsPrefix(pcis->pA_II,((PetscObject)pcbddc->ksp_D)->prefix);CHKERRQ(ierr); 5416 ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->pA_II);CHKERRQ(ierr); 5417 /* Allow user's customization */ 5418 if (opts) { 5419 ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr); 5420 } 5421 if (pcbddc->NullSpace_corr[0]) { /* approximate solver, propagate NearNullSpace */ 5422 ierr = MatNullSpacePropagate_Private(pcbddc->local_mat,pcis->is_I_local,pcis->pA_II);CHKERRQ(ierr); 5423 } 5424 ierr = MatGetNearNullSpace(pcis->pA_II,&nnsp);CHKERRQ(ierr); 5425 ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr); 5426 ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr); 5427 if (f && pcbddc->mat_graph->cloc && !nnsp) { 5428 PetscReal *coords = pcbddc->mat_graph->coords,*scoords; 5429 const PetscInt *idxs; 5430 PetscInt cdim = pcbddc->mat_graph->cdim,nl,i,d; 5431 5432 ierr = ISGetLocalSize(pcis->is_I_local,&nl);CHKERRQ(ierr); 5433 ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr); 5434 ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr); 5435 for (i=0;i<nl;i++) { 5436 for (d=0;d<cdim;d++) { 5437 scoords[i*cdim+d] = coords[idxs[i]*cdim+d]; 5438 } 5439 } 5440 ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr); 5441 ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr); 5442 ierr = PetscFree(scoords);CHKERRQ(ierr); 5443 } 5444 if (sub_schurs && sub_schurs->reuse_solver) { 5445 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 5446 5447 ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr); 5448 } 5449 5450 /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */ 5451 if (!n_D) { 5452 ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr); 5453 ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr); 5454 } 5455 /* set ksp_D into pcis data */ 5456 ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr); 5457 ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr); 5458 pcis->ksp_D = pcbddc->ksp_D; 5459 } 5460 5461 /* NEUMANN PROBLEM */ 5462 A_RR = 0; 5463 if (neumann) { 5464 PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs; 5465 PetscInt ibs,mbs; 5466 PetscBool issbaij, reuse_neumann_solver; 5467 Mat_IS* matis = (Mat_IS*)pc->pmat->data; 5468 5469 reuse_neumann_solver = PETSC_FALSE; 5470 if (sub_schurs && sub_schurs->reuse_solver) { 5471 IS iP; 5472 5473 reuse_neumann_solver = PETSC_TRUE; 5474 ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr); 5475 if (iP) reuse_neumann_solver = PETSC_FALSE; 5476 } 5477 /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */ 5478 ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr); 5479 if (pcbddc->ksp_R) { /* already created ksp */ 5480 PetscInt nn_R; 5481 ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr); 5482 ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr); 5483 ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr); 5484 if (nn_R != n_R) { /* old ksp is not reusable, so reset it */ 5485 ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr); 5486 ierr = MatDestroy(&A_RR);CHKERRQ(ierr); 5487 reuse = MAT_INITIAL_MATRIX; 5488 } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */ 5489 if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */ 5490 ierr = MatDestroy(&A_RR);CHKERRQ(ierr); 5491 reuse = MAT_INITIAL_MATRIX; 5492 } else { /* safe to reuse the matrix */ 5493 reuse = MAT_REUSE_MATRIX; 5494 } 5495 } 5496 /* last check */ 5497 if (pc->flag == DIFFERENT_NONZERO_PATTERN) { 5498 ierr = MatDestroy(&A_RR);CHKERRQ(ierr); 5499 reuse = MAT_INITIAL_MATRIX; 5500 } 5501 } else { /* first time, so we need to create the matrix */ 5502 reuse = MAT_INITIAL_MATRIX; 5503 } 5504 /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */ 5505 ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr); 5506 ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr); 5507 ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr); 5508 if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */ 5509 if (matis->A == pcbddc->local_mat) { 5510 ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr); 5511 ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr); 5512 } else { 5513 ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr); 5514 } 5515 } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */ 5516 if (matis->A == pcbddc->local_mat) { 5517 ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr); 5518 ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr); 5519 } else { 5520 ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr); 5521 } 5522 } 5523 /* extract A_RR */ 5524 if (reuse_neumann_solver) { 5525 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 5526 5527 if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */ 5528 ierr = MatDestroy(&A_RR);CHKERRQ(ierr); 5529 if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */ 5530 ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr); 5531 } else { 5532 ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr); 5533 } 5534 } else { 5535 ierr = MatDestroy(&A_RR);CHKERRQ(ierr); 5536 ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr); 5537 ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr); 5538 } 5539 } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */ 5540 ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr); 5541 } 5542 if (pcbddc->local_mat->symmetric_set) { 5543 ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr); 5544 } 5545 opts = PETSC_FALSE; 5546 if (!pcbddc->ksp_R) { /* create object if not present */ 5547 opts = PETSC_TRUE; 5548 ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr); 5549 ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr); 5550 /* default */ 5551 ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr); 5552 ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr); 5553 ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr); 5554 ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr); 5555 if (issbaij) { 5556 ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr); 5557 } else { 5558 ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr); 5559 } 5560 ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_R,pc->erroriffailure);CHKERRQ(ierr); 5561 } 5562 ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr); 5563 ierr = MatSetOptionsPrefix(A_RR,((PetscObject)pcbddc->ksp_R)->prefix);CHKERRQ(ierr); 5564 if (opts) { /* Allow user's customization once */ 5565 ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr); 5566 } 5567 if (pcbddc->NullSpace_corr[2]) { /* approximate solver, propagate NearNullSpace */ 5568 ierr = MatNullSpacePropagate_Private(pcbddc->local_mat,pcbddc->is_R_local,A_RR);CHKERRQ(ierr); 5569 } 5570 ierr = MatGetNearNullSpace(A_RR,&nnsp);CHKERRQ(ierr); 5571 ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr); 5572 ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr); 5573 if (f && pcbddc->mat_graph->cloc && !nnsp) { 5574 PetscReal *coords = pcbddc->mat_graph->coords,*scoords; 5575 const PetscInt *idxs; 5576 PetscInt cdim = pcbddc->mat_graph->cdim,nl,i,d; 5577 5578 ierr = ISGetLocalSize(pcbddc->is_R_local,&nl);CHKERRQ(ierr); 5579 ierr = ISGetIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr); 5580 ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr); 5581 for (i=0;i<nl;i++) { 5582 for (d=0;d<cdim;d++) { 5583 scoords[i*cdim+d] = coords[idxs[i]*cdim+d]; 5584 } 5585 } 5586 ierr = ISRestoreIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr); 5587 ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr); 5588 ierr = PetscFree(scoords);CHKERRQ(ierr); 5589 } 5590 5591 /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */ 5592 if (!n_R) { 5593 ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr); 5594 ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr); 5595 } 5596 /* Reuse solver if it is present */ 5597 if (reuse_neumann_solver) { 5598 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 5599 5600 ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr); 5601 } 5602 } 5603 5604 if (pcbddc->dbg_flag) { 5605 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 5606 ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr); 5607 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr); 5608 } 5609 5610 /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */ 5611 if (pcbddc->NullSpace_corr[0]) { 5612 ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr); 5613 } 5614 if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) { 5615 ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr); 5616 } 5617 if (neumann && pcbddc->NullSpace_corr[2]) { 5618 ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr); 5619 } 5620 /* check Dirichlet and Neumann solvers */ 5621 if (pcbddc->dbg_flag) { 5622 if (dirichlet) { /* Dirichlet */ 5623 ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr); 5624 ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr); 5625 ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr); 5626 ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr); 5627 ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr); 5628 ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr); 5629 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); 5630 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 5631 } 5632 if (neumann) { /* Neumann */ 5633 ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr); 5634 ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr); 5635 ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr); 5636 ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr); 5637 ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr); 5638 ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr); 5639 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); 5640 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 5641 } 5642 } 5643 /* free Neumann problem's matrix */ 5644 ierr = MatDestroy(&A_RR);CHKERRQ(ierr); 5645 ierr = PetscLogEventEnd(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr); 5646 PetscFunctionReturn(0); 5647 } 5648 5649 static PetscErrorCode PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose) 5650 { 5651 PetscErrorCode ierr; 5652 PC_BDDC* pcbddc = (PC_BDDC*)(pc->data); 5653 PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs; 5654 PetscBool reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE; 5655 5656 PetscFunctionBegin; 5657 if (!reuse_solver) { 5658 ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr); 5659 } 5660 if (!pcbddc->switch_static) { 5661 if (applytranspose && pcbddc->local_auxmat1) { 5662 ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr); 5663 ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr); 5664 } 5665 if (!reuse_solver) { 5666 ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5667 ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5668 } else { 5669 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 5670 5671 ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5672 ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5673 } 5674 } else { 5675 ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5676 ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5677 ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5678 ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5679 if (applytranspose && pcbddc->local_auxmat1) { 5680 ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr); 5681 ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr); 5682 ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5683 ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5684 } 5685 } 5686 if (!reuse_solver || pcbddc->switch_static) { 5687 if (applytranspose) { 5688 ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr); 5689 } else { 5690 ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr); 5691 } 5692 ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec1_R);CHKERRQ(ierr); 5693 } else { 5694 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 5695 5696 if (applytranspose) { 5697 ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr); 5698 } else { 5699 ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr); 5700 } 5701 } 5702 ierr = VecSet(inout_B,0.);CHKERRQ(ierr); 5703 if (!pcbddc->switch_static) { 5704 if (!reuse_solver) { 5705 ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5706 ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5707 } else { 5708 PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver; 5709 5710 ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5711 ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5712 } 5713 if (!applytranspose && pcbddc->local_auxmat1) { 5714 ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr); 5715 ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr); 5716 } 5717 } else { 5718 ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5719 ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5720 ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5721 ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5722 if (!applytranspose && pcbddc->local_auxmat1) { 5723 ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr); 5724 ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr); 5725 } 5726 ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5727 ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5728 ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5729 ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5730 } 5731 PetscFunctionReturn(0); 5732 } 5733 5734 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */ 5735 PetscErrorCode PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose) 5736 { 5737 PetscErrorCode ierr; 5738 PC_BDDC* pcbddc = (PC_BDDC*)(pc->data); 5739 PC_IS* pcis = (PC_IS*) (pc->data); 5740 const PetscScalar zero = 0.0; 5741 5742 PetscFunctionBegin; 5743 /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */ 5744 if (!pcbddc->benign_apply_coarse_only) { 5745 if (applytranspose) { 5746 ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr); 5747 if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); } 5748 } else { 5749 ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr); 5750 if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); } 5751 } 5752 } else { 5753 ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr); 5754 } 5755 5756 /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */ 5757 if (pcbddc->benign_n) { 5758 PetscScalar *array; 5759 PetscInt j; 5760 5761 ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 5762 for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j]; 5763 ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 5764 } 5765 5766 /* start communications from local primal nodes to rhs of coarse solver */ 5767 ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr); 5768 ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5769 ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 5770 5771 /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */ 5772 if (pcbddc->coarse_ksp) { 5773 Mat coarse_mat; 5774 Vec rhs,sol; 5775 MatNullSpace nullsp; 5776 PetscBool isbddc = PETSC_FALSE; 5777 5778 if (pcbddc->benign_have_null) { 5779 PC coarse_pc; 5780 5781 ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr); 5782 ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr); 5783 /* we need to propagate to coarser levels the need for a possible benign correction */ 5784 if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) { 5785 PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data); 5786 coarsepcbddc->benign_skip_correction = PETSC_FALSE; 5787 coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE; 5788 } 5789 } 5790 ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr); 5791 ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr); 5792 ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr); 5793 if (applytranspose) { 5794 if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented"); 5795 ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr); 5796 ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr); 5797 ierr = MatGetTransposeNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr); 5798 if (nullsp) { 5799 ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr); 5800 } 5801 } else { 5802 ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr); 5803 if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */ 5804 PC coarse_pc; 5805 5806 if (nullsp) { 5807 ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr); 5808 } 5809 ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr); 5810 ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr); 5811 ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr); 5812 ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr); 5813 } else { 5814 ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr); 5815 ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr); 5816 if (nullsp) { 5817 ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr); 5818 } 5819 } 5820 } 5821 /* we don't need the benign correction at coarser levels anymore */ 5822 if (pcbddc->benign_have_null && isbddc) { 5823 PC coarse_pc; 5824 PC_BDDC* coarsepcbddc; 5825 5826 ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr); 5827 coarsepcbddc = (PC_BDDC*)(coarse_pc->data); 5828 coarsepcbddc->benign_skip_correction = PETSC_TRUE; 5829 coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE; 5830 } 5831 } 5832 5833 /* Local solution on R nodes */ 5834 if (pcis->n && !pcbddc->benign_apply_coarse_only) { 5835 ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr); 5836 } 5837 /* communications from coarse sol to local primal nodes */ 5838 ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5839 ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 5840 5841 /* Sum contributions from the two levels */ 5842 if (!pcbddc->benign_apply_coarse_only) { 5843 if (applytranspose) { 5844 ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr); 5845 if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); } 5846 } else { 5847 ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr); 5848 if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); } 5849 } 5850 /* store p0 */ 5851 if (pcbddc->benign_n) { 5852 PetscScalar *array; 5853 PetscInt j; 5854 5855 ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 5856 for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j]; 5857 ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 5858 } 5859 } else { /* expand the coarse solution */ 5860 if (applytranspose) { 5861 ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr); 5862 } else { 5863 ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr); 5864 } 5865 } 5866 PetscFunctionReturn(0); 5867 } 5868 5869 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode) 5870 { 5871 PetscErrorCode ierr; 5872 PC_BDDC* pcbddc = (PC_BDDC*)(pc->data); 5873 PetscScalar *array; 5874 Vec from,to; 5875 5876 PetscFunctionBegin; 5877 if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */ 5878 from = pcbddc->coarse_vec; 5879 to = pcbddc->vec1_P; 5880 if (pcbddc->coarse_ksp) { /* get array from coarse processes */ 5881 Vec tvec; 5882 5883 ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr); 5884 ierr = VecResetArray(tvec);CHKERRQ(ierr); 5885 ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr); 5886 ierr = VecGetArray(tvec,&array);CHKERRQ(ierr); 5887 ierr = VecPlaceArray(from,array);CHKERRQ(ierr); 5888 ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr); 5889 } 5890 } else { /* from local to global -> put data in coarse right hand side */ 5891 from = pcbddc->vec1_P; 5892 to = pcbddc->coarse_vec; 5893 } 5894 ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr); 5895 PetscFunctionReturn(0); 5896 } 5897 5898 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode) 5899 { 5900 PetscErrorCode ierr; 5901 PC_BDDC* pcbddc = (PC_BDDC*)(pc->data); 5902 PetscScalar *array; 5903 Vec from,to; 5904 5905 PetscFunctionBegin; 5906 if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */ 5907 from = pcbddc->coarse_vec; 5908 to = pcbddc->vec1_P; 5909 } else { /* from local to global -> put data in coarse right hand side */ 5910 from = pcbddc->vec1_P; 5911 to = pcbddc->coarse_vec; 5912 } 5913 ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr); 5914 if (smode == SCATTER_FORWARD) { 5915 if (pcbddc->coarse_ksp) { /* get array from coarse processes */ 5916 Vec tvec; 5917 5918 ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr); 5919 ierr = VecGetArray(to,&array);CHKERRQ(ierr); 5920 ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr); 5921 ierr = VecRestoreArray(to,&array);CHKERRQ(ierr); 5922 } 5923 } else { 5924 if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */ 5925 ierr = VecResetArray(from);CHKERRQ(ierr); 5926 } 5927 } 5928 PetscFunctionReturn(0); 5929 } 5930 5931 /* uncomment for testing purposes */ 5932 /* #define PETSC_MISSING_LAPACK_GESVD 1 */ 5933 PetscErrorCode PCBDDCConstraintsSetUp(PC pc) 5934 { 5935 PetscErrorCode ierr; 5936 PC_IS* pcis = (PC_IS*)(pc->data); 5937 PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 5938 Mat_IS* matis = (Mat_IS*)pc->pmat->data; 5939 /* one and zero */ 5940 PetscScalar one=1.0,zero=0.0; 5941 /* space to store constraints and their local indices */ 5942 PetscScalar *constraints_data; 5943 PetscInt *constraints_idxs,*constraints_idxs_B; 5944 PetscInt *constraints_idxs_ptr,*constraints_data_ptr; 5945 PetscInt *constraints_n; 5946 /* iterators */ 5947 PetscInt i,j,k,total_counts,total_counts_cc,cum; 5948 /* BLAS integers */ 5949 PetscBLASInt lwork,lierr; 5950 PetscBLASInt Blas_N,Blas_M,Blas_K,Blas_one=1; 5951 PetscBLASInt Blas_LDA,Blas_LDB,Blas_LDC; 5952 /* reuse */ 5953 PetscInt olocal_primal_size,olocal_primal_size_cc; 5954 PetscInt *olocal_primal_ref_node,*olocal_primal_ref_mult; 5955 /* change of basis */ 5956 PetscBool qr_needed; 5957 PetscBT change_basis,qr_needed_idx; 5958 /* auxiliary stuff */ 5959 PetscInt *nnz,*is_indices; 5960 PetscInt ncc; 5961 /* some quantities */ 5962 PetscInt n_vertices,total_primal_vertices,valid_constraints; 5963 PetscInt size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints; 5964 PetscReal tol; /* tolerance for retaining eigenmodes */ 5965 5966 PetscFunctionBegin; 5967 tol = PetscSqrtReal(PETSC_SMALL); 5968 /* Destroy Mat objects computed previously */ 5969 ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr); 5970 ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr); 5971 ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr); 5972 /* save info on constraints from previous setup (if any) */ 5973 olocal_primal_size = pcbddc->local_primal_size; 5974 olocal_primal_size_cc = pcbddc->local_primal_size_cc; 5975 ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr); 5976 ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr); 5977 ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr); 5978 ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr); 5979 ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr); 5980 5981 if (!pcbddc->adaptive_selection) { 5982 IS ISForVertices,*ISForFaces,*ISForEdges; 5983 MatNullSpace nearnullsp; 5984 const Vec *nearnullvecs; 5985 Vec *localnearnullsp; 5986 PetscScalar *array; 5987 PetscInt n_ISForFaces,n_ISForEdges,nnsp_size; 5988 PetscBool nnsp_has_cnst; 5989 /* LAPACK working arrays for SVD or POD */ 5990 PetscBool skip_lapack,boolforchange; 5991 PetscScalar *work; 5992 PetscReal *singular_vals; 5993 #if defined(PETSC_USE_COMPLEX) 5994 PetscReal *rwork; 5995 #endif 5996 #if defined(PETSC_MISSING_LAPACK_GESVD) 5997 PetscScalar *temp_basis,*correlation_mat; 5998 #else 5999 PetscBLASInt dummy_int=1; 6000 PetscScalar dummy_scalar=1.; 6001 #endif 6002 6003 /* Get index sets for faces, edges and vertices from graph */ 6004 ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr); 6005 /* print some info */ 6006 if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) { 6007 PetscInt nv; 6008 6009 ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr); 6010 ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr); 6011 ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr); 6012 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr); 6013 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr); 6014 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges (%D)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr); 6015 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces (%D)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr); 6016 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 6017 ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr); 6018 } 6019 6020 /* free unneeded index sets */ 6021 if (!pcbddc->use_vertices) { 6022 ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr); 6023 } 6024 if (!pcbddc->use_edges) { 6025 for (i=0;i<n_ISForEdges;i++) { 6026 ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr); 6027 } 6028 ierr = PetscFree(ISForEdges);CHKERRQ(ierr); 6029 n_ISForEdges = 0; 6030 } 6031 if (!pcbddc->use_faces) { 6032 for (i=0;i<n_ISForFaces;i++) { 6033 ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr); 6034 } 6035 ierr = PetscFree(ISForFaces);CHKERRQ(ierr); 6036 n_ISForFaces = 0; 6037 } 6038 6039 /* check if near null space is attached to global mat */ 6040 ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr); 6041 if (nearnullsp) { 6042 ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr); 6043 /* remove any stored info */ 6044 ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr); 6045 ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr); 6046 /* store information for BDDC solver reuse */ 6047 ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr); 6048 pcbddc->onearnullspace = nearnullsp; 6049 ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr); 6050 for (i=0;i<nnsp_size;i++) { 6051 ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr); 6052 } 6053 } else { /* if near null space is not provided BDDC uses constants by default */ 6054 nnsp_size = 0; 6055 nnsp_has_cnst = PETSC_TRUE; 6056 } 6057 /* get max number of constraints on a single cc */ 6058 max_constraints = nnsp_size; 6059 if (nnsp_has_cnst) max_constraints++; 6060 6061 /* 6062 Evaluate maximum storage size needed by the procedure 6063 - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]" 6064 - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]" 6065 There can be multiple constraints per connected component 6066 */ 6067 n_vertices = 0; 6068 if (ISForVertices) { 6069 ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr); 6070 } 6071 ncc = n_vertices+n_ISForFaces+n_ISForEdges; 6072 ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr); 6073 6074 total_counts = n_ISForFaces+n_ISForEdges; 6075 total_counts *= max_constraints; 6076 total_counts += n_vertices; 6077 ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr); 6078 6079 total_counts = 0; 6080 max_size_of_constraint = 0; 6081 for (i=0;i<n_ISForEdges+n_ISForFaces;i++) { 6082 IS used_is; 6083 if (i<n_ISForEdges) { 6084 used_is = ISForEdges[i]; 6085 } else { 6086 used_is = ISForFaces[i-n_ISForEdges]; 6087 } 6088 ierr = ISGetSize(used_is,&j);CHKERRQ(ierr); 6089 total_counts += j; 6090 max_size_of_constraint = PetscMax(j,max_size_of_constraint); 6091 } 6092 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); 6093 6094 /* get local part of global near null space vectors */ 6095 ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr); 6096 for (k=0;k<nnsp_size;k++) { 6097 ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr); 6098 ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 6099 ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 6100 } 6101 6102 /* whether or not to skip lapack calls */ 6103 skip_lapack = PETSC_TRUE; 6104 if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE; 6105 6106 /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */ 6107 if (!skip_lapack) { 6108 PetscScalar temp_work; 6109 6110 #if defined(PETSC_MISSING_LAPACK_GESVD) 6111 /* Proper Orthogonal Decomposition (POD) using the snapshot method */ 6112 ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr); 6113 ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr); 6114 ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr); 6115 #if defined(PETSC_USE_COMPLEX) 6116 ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr); 6117 #endif 6118 /* now we evaluate the optimal workspace using query with lwork=-1 */ 6119 ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr); 6120 ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr); 6121 lwork = -1; 6122 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 6123 #if !defined(PETSC_USE_COMPLEX) 6124 PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr)); 6125 #else 6126 PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr)); 6127 #endif 6128 ierr = PetscFPTrapPop();CHKERRQ(ierr); 6129 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr); 6130 #else /* on missing GESVD */ 6131 /* SVD */ 6132 PetscInt max_n,min_n; 6133 max_n = max_size_of_constraint; 6134 min_n = max_constraints; 6135 if (max_size_of_constraint < max_constraints) { 6136 min_n = max_size_of_constraint; 6137 max_n = max_constraints; 6138 } 6139 ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr); 6140 #if defined(PETSC_USE_COMPLEX) 6141 ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr); 6142 #endif 6143 /* now we evaluate the optimal workspace using query with lwork=-1 */ 6144 lwork = -1; 6145 ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr); 6146 ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr); 6147 ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr); 6148 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 6149 #if !defined(PETSC_USE_COMPLEX) 6150 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)); 6151 #else 6152 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)); 6153 #endif 6154 ierr = PetscFPTrapPop();CHKERRQ(ierr); 6155 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr); 6156 #endif /* on missing GESVD */ 6157 /* Allocate optimal workspace */ 6158 ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr); 6159 ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr); 6160 } 6161 /* Now we can loop on constraining sets */ 6162 total_counts = 0; 6163 constraints_idxs_ptr[0] = 0; 6164 constraints_data_ptr[0] = 0; 6165 /* vertices */ 6166 if (n_vertices) { 6167 ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr); 6168 ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr); 6169 for (i=0;i<n_vertices;i++) { 6170 constraints_n[total_counts] = 1; 6171 constraints_data[total_counts] = 1.0; 6172 constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1; 6173 constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1; 6174 total_counts++; 6175 } 6176 ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr); 6177 n_vertices = total_counts; 6178 } 6179 6180 /* edges and faces */ 6181 total_counts_cc = total_counts; 6182 for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) { 6183 IS used_is; 6184 PetscBool idxs_copied = PETSC_FALSE; 6185 6186 if (ncc<n_ISForEdges) { 6187 used_is = ISForEdges[ncc]; 6188 boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */ 6189 } else { 6190 used_is = ISForFaces[ncc-n_ISForEdges]; 6191 boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */ 6192 } 6193 temp_constraints = 0; /* zero the number of constraints I have on this conn comp */ 6194 6195 ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr); 6196 ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr); 6197 /* change of basis should not be performed on local periodic nodes */ 6198 if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE; 6199 if (nnsp_has_cnst) { 6200 PetscScalar quad_value; 6201 6202 ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr); 6203 idxs_copied = PETSC_TRUE; 6204 6205 if (!pcbddc->use_nnsp_true) { 6206 quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint)); 6207 } else { 6208 quad_value = 1.0; 6209 } 6210 for (j=0;j<size_of_constraint;j++) { 6211 constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value; 6212 } 6213 temp_constraints++; 6214 total_counts++; 6215 } 6216 for (k=0;k<nnsp_size;k++) { 6217 PetscReal real_value; 6218 PetscScalar *ptr_to_data; 6219 6220 ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr); 6221 ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint]; 6222 for (j=0;j<size_of_constraint;j++) { 6223 ptr_to_data[j] = array[is_indices[j]]; 6224 } 6225 ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr); 6226 /* check if array is null on the connected component */ 6227 ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr); 6228 PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one)); 6229 if (real_value > tol*size_of_constraint) { /* keep indices and values */ 6230 temp_constraints++; 6231 total_counts++; 6232 if (!idxs_copied) { 6233 ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr); 6234 idxs_copied = PETSC_TRUE; 6235 } 6236 } 6237 } 6238 ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr); 6239 valid_constraints = temp_constraints; 6240 if (!pcbddc->use_nnsp_true && temp_constraints) { 6241 if (temp_constraints == 1) { /* just normalize the constraint */ 6242 PetscScalar norm,*ptr_to_data; 6243 6244 ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]]; 6245 ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr); 6246 PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one)); 6247 norm = 1.0/PetscSqrtReal(PetscRealPart(norm)); 6248 PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one)); 6249 } else { /* perform SVD */ 6250 PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]]; 6251 6252 #if defined(PETSC_MISSING_LAPACK_GESVD) 6253 /* SVD: Y = U*S*V^H -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag 6254 POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2) 6255 -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined 6256 the constraints basis will differ (by a complex factor with absolute value equal to 1) 6257 from that computed using LAPACKgesvd 6258 -> This is due to a different computation of eigenvectors in LAPACKheev 6259 -> The quality of the POD-computed basis will be the same */ 6260 ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr); 6261 /* Store upper triangular part of correlation matrix */ 6262 ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr); 6263 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 6264 for (j=0;j<temp_constraints;j++) { 6265 for (k=0;k<j+1;k++) { 6266 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)); 6267 } 6268 } 6269 /* compute eigenvalues and eigenvectors of correlation matrix */ 6270 ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr); 6271 ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr); 6272 #if !defined(PETSC_USE_COMPLEX) 6273 PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr)); 6274 #else 6275 PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr)); 6276 #endif 6277 ierr = PetscFPTrapPop();CHKERRQ(ierr); 6278 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr); 6279 /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */ 6280 j = 0; 6281 while (j < temp_constraints && singular_vals[j]/singular_vals[temp_constraints-1] < tol) j++; 6282 total_counts = total_counts-j; 6283 valid_constraints = temp_constraints-j; 6284 /* scale and copy POD basis into used quadrature memory */ 6285 ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr); 6286 ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr); 6287 ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr); 6288 ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 6289 ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr); 6290 ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr); 6291 if (j<temp_constraints) { 6292 PetscInt ii; 6293 for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]); 6294 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 6295 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)); 6296 ierr = PetscFPTrapPop();CHKERRQ(ierr); 6297 for (k=0;k<temp_constraints-j;k++) { 6298 for (ii=0;ii<size_of_constraint;ii++) { 6299 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii]; 6300 } 6301 } 6302 } 6303 #else /* on missing GESVD */ 6304 ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr); 6305 ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr); 6306 ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 6307 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 6308 #if !defined(PETSC_USE_COMPLEX) 6309 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)); 6310 #else 6311 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)); 6312 #endif 6313 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr); 6314 ierr = PetscFPTrapPop();CHKERRQ(ierr); 6315 /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */ 6316 k = temp_constraints; 6317 if (k > size_of_constraint) k = size_of_constraint; 6318 j = 0; 6319 while (j < k && singular_vals[k-j-1]/singular_vals[0] < tol) j++; 6320 valid_constraints = k-j; 6321 total_counts = total_counts-temp_constraints+valid_constraints; 6322 #endif /* on missing GESVD */ 6323 } 6324 } 6325 /* update pointers information */ 6326 if (valid_constraints) { 6327 constraints_n[total_counts_cc] = valid_constraints; 6328 constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint; 6329 constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints; 6330 /* set change_of_basis flag */ 6331 if (boolforchange) { 6332 PetscBTSet(change_basis,total_counts_cc); 6333 } 6334 total_counts_cc++; 6335 } 6336 } 6337 /* free workspace */ 6338 if (!skip_lapack) { 6339 ierr = PetscFree(work);CHKERRQ(ierr); 6340 #if defined(PETSC_USE_COMPLEX) 6341 ierr = PetscFree(rwork);CHKERRQ(ierr); 6342 #endif 6343 ierr = PetscFree(singular_vals);CHKERRQ(ierr); 6344 #if defined(PETSC_MISSING_LAPACK_GESVD) 6345 ierr = PetscFree(correlation_mat);CHKERRQ(ierr); 6346 ierr = PetscFree(temp_basis);CHKERRQ(ierr); 6347 #endif 6348 } 6349 for (k=0;k<nnsp_size;k++) { 6350 ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr); 6351 } 6352 ierr = PetscFree(localnearnullsp);CHKERRQ(ierr); 6353 /* free index sets of faces, edges and vertices */ 6354 for (i=0;i<n_ISForFaces;i++) { 6355 ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr); 6356 } 6357 if (n_ISForFaces) { 6358 ierr = PetscFree(ISForFaces);CHKERRQ(ierr); 6359 } 6360 for (i=0;i<n_ISForEdges;i++) { 6361 ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr); 6362 } 6363 if (n_ISForEdges) { 6364 ierr = PetscFree(ISForEdges);CHKERRQ(ierr); 6365 } 6366 ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr); 6367 } else { 6368 PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs; 6369 6370 total_counts = 0; 6371 n_vertices = 0; 6372 if (sub_schurs->is_vertices && pcbddc->use_vertices) { 6373 ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr); 6374 } 6375 max_constraints = 0; 6376 total_counts_cc = 0; 6377 for (i=0;i<sub_schurs->n_subs+n_vertices;i++) { 6378 total_counts += pcbddc->adaptive_constraints_n[i]; 6379 if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++; 6380 max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]); 6381 } 6382 constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr; 6383 constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr; 6384 constraints_idxs = pcbddc->adaptive_constraints_idxs; 6385 constraints_data = pcbddc->adaptive_constraints_data; 6386 /* constraints_n differs from pcbddc->adaptive_constraints_n */ 6387 ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr); 6388 total_counts_cc = 0; 6389 for (i=0;i<sub_schurs->n_subs+n_vertices;i++) { 6390 if (pcbddc->adaptive_constraints_n[i]) { 6391 constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i]; 6392 } 6393 } 6394 6395 max_size_of_constraint = 0; 6396 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]); 6397 ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr); 6398 /* Change of basis */ 6399 ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr); 6400 if (pcbddc->use_change_of_basis) { 6401 for (i=0;i<sub_schurs->n_subs;i++) { 6402 if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) { 6403 ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr); 6404 } 6405 } 6406 } 6407 } 6408 pcbddc->local_primal_size = total_counts; 6409 ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr); 6410 6411 /* map constraints_idxs in boundary numbering */ 6412 ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr); 6413 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); 6414 6415 /* Create constraint matrix */ 6416 ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr); 6417 ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr); 6418 ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr); 6419 6420 /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */ 6421 /* determine if a QR strategy is needed for change of basis */ 6422 qr_needed = pcbddc->use_qr_single; 6423 ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr); 6424 total_primal_vertices=0; 6425 pcbddc->local_primal_size_cc = 0; 6426 for (i=0;i<total_counts_cc;i++) { 6427 size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i]; 6428 if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) { 6429 pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]]; 6430 pcbddc->local_primal_size_cc += 1; 6431 } else if (PetscBTLookup(change_basis,i)) { 6432 for (k=0;k<constraints_n[i];k++) { 6433 pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k]; 6434 } 6435 pcbddc->local_primal_size_cc += constraints_n[i]; 6436 if (constraints_n[i] > 1 || pcbddc->use_qr_single) { 6437 PetscBTSet(qr_needed_idx,i); 6438 qr_needed = PETSC_TRUE; 6439 } 6440 } else { 6441 pcbddc->local_primal_size_cc += 1; 6442 } 6443 } 6444 /* note that the local variable n_vertices used below stores the number of pointwise constraints */ 6445 pcbddc->n_vertices = total_primal_vertices; 6446 /* permute indices in order to have a sorted set of vertices */ 6447 ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr); 6448 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); 6449 ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr); 6450 for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1; 6451 6452 /* nonzero structure of constraint matrix */ 6453 /* and get reference dof for local constraints */ 6454 ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr); 6455 for (i=0;i<total_primal_vertices;i++) nnz[i] = 1; 6456 6457 j = total_primal_vertices; 6458 total_counts = total_primal_vertices; 6459 cum = total_primal_vertices; 6460 for (i=n_vertices;i<total_counts_cc;i++) { 6461 if (!PetscBTLookup(change_basis,i)) { 6462 pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]]; 6463 pcbddc->local_primal_ref_mult[cum] = constraints_n[i]; 6464 cum++; 6465 size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i]; 6466 for (k=0;k<constraints_n[i];k++) { 6467 pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k]; 6468 nnz[j+k] = size_of_constraint; 6469 } 6470 j += constraints_n[i]; 6471 } 6472 } 6473 ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr); 6474 ierr = MatSetOption(pcbddc->ConstraintMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr); 6475 ierr = PetscFree(nnz);CHKERRQ(ierr); 6476 6477 /* set values in constraint matrix */ 6478 for (i=0;i<total_primal_vertices;i++) { 6479 ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr); 6480 } 6481 total_counts = total_primal_vertices; 6482 for (i=n_vertices;i<total_counts_cc;i++) { 6483 if (!PetscBTLookup(change_basis,i)) { 6484 PetscInt *cols; 6485 6486 size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i]; 6487 cols = constraints_idxs+constraints_idxs_ptr[i]; 6488 for (k=0;k<constraints_n[i];k++) { 6489 PetscInt row = total_counts+k; 6490 PetscScalar *vals; 6491 6492 vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint; 6493 ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr); 6494 } 6495 total_counts += constraints_n[i]; 6496 } 6497 } 6498 /* assembling */ 6499 ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 6500 ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 6501 ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,NULL,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr); 6502 6503 /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */ 6504 if (pcbddc->use_change_of_basis) { 6505 /* dual and primal dofs on a single cc */ 6506 PetscInt dual_dofs,primal_dofs; 6507 /* working stuff for GEQRF */ 6508 PetscScalar *qr_basis = NULL,*qr_tau = NULL,*qr_work = NULL,lqr_work_t; 6509 PetscBLASInt lqr_work; 6510 /* working stuff for UNGQR */ 6511 PetscScalar *gqr_work = NULL,lgqr_work_t; 6512 PetscBLASInt lgqr_work; 6513 /* working stuff for TRTRS */ 6514 PetscScalar *trs_rhs = NULL; 6515 PetscBLASInt Blas_NRHS; 6516 /* pointers for values insertion into change of basis matrix */ 6517 PetscInt *start_rows,*start_cols; 6518 PetscScalar *start_vals; 6519 /* working stuff for values insertion */ 6520 PetscBT is_primal; 6521 PetscInt *aux_primal_numbering_B; 6522 /* matrix sizes */ 6523 PetscInt global_size,local_size; 6524 /* temporary change of basis */ 6525 Mat localChangeOfBasisMatrix; 6526 /* extra space for debugging */ 6527 PetscScalar *dbg_work = NULL; 6528 6529 /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */ 6530 ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr); 6531 ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr); 6532 ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr); 6533 /* nonzeros for local mat */ 6534 ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr); 6535 if (!pcbddc->benign_change || pcbddc->fake_change) { 6536 for (i=0;i<pcis->n;i++) nnz[i]=1; 6537 } else { 6538 const PetscInt *ii; 6539 PetscInt n; 6540 PetscBool flg_row; 6541 ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr); 6542 for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i]; 6543 ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr); 6544 } 6545 for (i=n_vertices;i<total_counts_cc;i++) { 6546 if (PetscBTLookup(change_basis,i)) { 6547 size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i]; 6548 if (PetscBTLookup(qr_needed_idx,i)) { 6549 for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint; 6550 } else { 6551 nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint; 6552 for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2; 6553 } 6554 } 6555 } 6556 ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr); 6557 ierr = MatSetOption(localChangeOfBasisMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr); 6558 ierr = PetscFree(nnz);CHKERRQ(ierr); 6559 /* Set interior change in the matrix */ 6560 if (!pcbddc->benign_change || pcbddc->fake_change) { 6561 for (i=0;i<pcis->n;i++) { 6562 ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr); 6563 } 6564 } else { 6565 const PetscInt *ii,*jj; 6566 PetscScalar *aa; 6567 PetscInt n; 6568 PetscBool flg_row; 6569 ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr); 6570 ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr); 6571 for (i=0;i<n;i++) { 6572 ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr); 6573 } 6574 ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr); 6575 ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr); 6576 } 6577 6578 if (pcbddc->dbg_flag) { 6579 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr); 6580 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr); 6581 } 6582 6583 6584 /* Now we loop on the constraints which need a change of basis */ 6585 /* 6586 Change of basis matrix is evaluated similarly to the FIRST APPROACH in 6587 Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1) 6588 6589 Basic blocks of change of basis matrix T computed by 6590 6591 - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified) 6592 6593 | 1 0 ... 0 s_1/S | 6594 | 0 1 ... 0 s_2/S | 6595 | ... | 6596 | 0 ... 1 s_{n-1}/S | 6597 | -s_1/s_n ... -s_{n-1}/s_n s_n/S | 6598 6599 with S = \sum_{i=1}^n s_i^2 6600 NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering 6601 in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering 6602 6603 - QR decomposition of constraints otherwise 6604 */ 6605 if (qr_needed && max_size_of_constraint) { 6606 /* space to store Q */ 6607 ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr); 6608 /* array to store scaling factors for reflectors */ 6609 ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr); 6610 /* first we issue queries for optimal work */ 6611 ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr); 6612 ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr); 6613 ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 6614 lqr_work = -1; 6615 PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr)); 6616 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr); 6617 ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr); 6618 ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr); 6619 lgqr_work = -1; 6620 ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr); 6621 ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr); 6622 ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr); 6623 ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 6624 if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */ 6625 PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr)); 6626 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr); 6627 ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr); 6628 ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr); 6629 /* array to store rhs and solution of triangular solver */ 6630 ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr); 6631 /* allocating workspace for check */ 6632 if (pcbddc->dbg_flag) { 6633 ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr); 6634 } 6635 } 6636 /* array to store whether a node is primal or not */ 6637 ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr); 6638 ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr); 6639 ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr); 6640 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); 6641 for (i=0;i<total_primal_vertices;i++) { 6642 ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr); 6643 } 6644 ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr); 6645 6646 /* loop on constraints and see whether or not they need a change of basis and compute it */ 6647 for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) { 6648 size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts]; 6649 if (PetscBTLookup(change_basis,total_counts)) { 6650 /* get constraint info */ 6651 primal_dofs = constraints_n[total_counts]; 6652 dual_dofs = size_of_constraint-primal_dofs; 6653 6654 if (pcbddc->dbg_flag) { 6655 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); 6656 } 6657 6658 if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */ 6659 6660 /* copy quadrature constraints for change of basis check */ 6661 if (pcbddc->dbg_flag) { 6662 ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr); 6663 } 6664 /* copy temporary constraints into larger work vector (in order to store all columns of Q) */ 6665 ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr); 6666 6667 /* compute QR decomposition of constraints */ 6668 ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr); 6669 ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr); 6670 ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 6671 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 6672 PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr)); 6673 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr); 6674 ierr = PetscFPTrapPop();CHKERRQ(ierr); 6675 6676 /* explictly compute R^-T */ 6677 ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr); 6678 for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0; 6679 ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr); 6680 ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr); 6681 ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 6682 ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr); 6683 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 6684 PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr)); 6685 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr); 6686 ierr = PetscFPTrapPop();CHKERRQ(ierr); 6687 6688 /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */ 6689 ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr); 6690 ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr); 6691 ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr); 6692 ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 6693 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 6694 PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr)); 6695 if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr); 6696 ierr = PetscFPTrapPop();CHKERRQ(ierr); 6697 6698 /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints 6699 i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below) 6700 where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */ 6701 ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr); 6702 ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr); 6703 ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr); 6704 ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 6705 ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr); 6706 ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr); 6707 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 6708 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)); 6709 ierr = PetscFPTrapPop();CHKERRQ(ierr); 6710 ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr); 6711 6712 /* insert values in change of basis matrix respecting global ordering of new primal dofs */ 6713 start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]]; 6714 /* insert cols for primal dofs */ 6715 for (j=0;j<primal_dofs;j++) { 6716 start_vals = &qr_basis[j*size_of_constraint]; 6717 start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j]; 6718 ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr); 6719 } 6720 /* insert cols for dual dofs */ 6721 for (j=0,k=0;j<dual_dofs;k++) { 6722 if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) { 6723 start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint]; 6724 start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k]; 6725 ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr); 6726 j++; 6727 } 6728 } 6729 6730 /* check change of basis */ 6731 if (pcbddc->dbg_flag) { 6732 PetscInt ii,jj; 6733 PetscBool valid_qr=PETSC_TRUE; 6734 ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr); 6735 ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr); 6736 ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr); 6737 ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr); 6738 ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr); 6739 ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr); 6740 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 6741 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)); 6742 ierr = PetscFPTrapPop();CHKERRQ(ierr); 6743 for (jj=0;jj<size_of_constraint;jj++) { 6744 for (ii=0;ii<primal_dofs;ii++) { 6745 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE; 6746 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE; 6747 } 6748 } 6749 if (!valid_qr) { 6750 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr); 6751 for (jj=0;jj<size_of_constraint;jj++) { 6752 for (ii=0;ii<primal_dofs;ii++) { 6753 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) { 6754 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); 6755 } 6756 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) { 6757 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); 6758 } 6759 } 6760 } 6761 } else { 6762 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr); 6763 } 6764 } 6765 } else { /* simple transformation block */ 6766 PetscInt row,col; 6767 PetscScalar val,norm; 6768 6769 ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr); 6770 PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one)); 6771 for (j=0;j<size_of_constraint;j++) { 6772 PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j]; 6773 row = constraints_idxs[constraints_idxs_ptr[total_counts]+j]; 6774 if (!PetscBTLookup(is_primal,row_B)) { 6775 col = constraints_idxs[constraints_idxs_ptr[total_counts]]; 6776 ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr); 6777 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr); 6778 } else { 6779 for (k=0;k<size_of_constraint;k++) { 6780 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k]; 6781 if (row != col) { 6782 val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]]; 6783 } else { 6784 val = constraints_data[constraints_data_ptr[total_counts]]/norm; 6785 } 6786 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr); 6787 } 6788 } 6789 } 6790 if (pcbddc->dbg_flag) { 6791 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr); 6792 } 6793 } 6794 } else { 6795 if (pcbddc->dbg_flag) { 6796 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %D does not need a change of basis (size %D)\n",total_counts,size_of_constraint);CHKERRQ(ierr); 6797 } 6798 } 6799 } 6800 6801 /* free workspace */ 6802 if (qr_needed) { 6803 if (pcbddc->dbg_flag) { 6804 ierr = PetscFree(dbg_work);CHKERRQ(ierr); 6805 } 6806 ierr = PetscFree(trs_rhs);CHKERRQ(ierr); 6807 ierr = PetscFree(qr_tau);CHKERRQ(ierr); 6808 ierr = PetscFree(qr_work);CHKERRQ(ierr); 6809 ierr = PetscFree(gqr_work);CHKERRQ(ierr); 6810 ierr = PetscFree(qr_basis);CHKERRQ(ierr); 6811 } 6812 ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr); 6813 ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 6814 ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 6815 6816 /* assembling of global change of variable */ 6817 if (!pcbddc->fake_change) { 6818 Mat tmat; 6819 PetscInt bs; 6820 6821 ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr); 6822 ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr); 6823 ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr); 6824 ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr); 6825 ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 6826 ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 6827 ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr); 6828 ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr); 6829 ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr); 6830 ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr); 6831 ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr); 6832 ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr); 6833 ierr = MatConvert(tmat,MATAIJ,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr); 6834 ierr = MatDestroy(&tmat);CHKERRQ(ierr); 6835 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 6836 ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr); 6837 ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 6838 ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 6839 ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr); 6840 ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr); 6841 6842 /* check */ 6843 if (pcbddc->dbg_flag) { 6844 PetscReal error; 6845 Vec x,x_change; 6846 6847 ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr); 6848 ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr); 6849 ierr = VecSetRandom(x,NULL);CHKERRQ(ierr); 6850 ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr); 6851 ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 6852 ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 6853 ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr); 6854 ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 6855 ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 6856 ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr); 6857 ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr); 6858 ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr); 6859 if (error > PETSC_SMALL) { 6860 SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error); 6861 } 6862 ierr = VecDestroy(&x);CHKERRQ(ierr); 6863 ierr = VecDestroy(&x_change);CHKERRQ(ierr); 6864 } 6865 /* adapt sub_schurs computed (if any) */ 6866 if (pcbddc->use_deluxe_scaling) { 6867 PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs; 6868 6869 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"); 6870 if (sub_schurs && sub_schurs->S_Ej_all) { 6871 Mat S_new,tmat; 6872 IS is_all_N,is_V_Sall = NULL; 6873 6874 ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr); 6875 ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr); 6876 if (pcbddc->deluxe_zerorows) { 6877 ISLocalToGlobalMapping NtoSall; 6878 IS is_V; 6879 ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr); 6880 ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr); 6881 ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr); 6882 ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr); 6883 ierr = ISDestroy(&is_V);CHKERRQ(ierr); 6884 } 6885 ierr = ISDestroy(&is_all_N);CHKERRQ(ierr); 6886 ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr); 6887 ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr); 6888 ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr); 6889 if (pcbddc->deluxe_zerorows) { 6890 const PetscScalar *array; 6891 const PetscInt *idxs_V,*idxs_all; 6892 PetscInt i,n_V; 6893 6894 ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr); 6895 ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr); 6896 ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr); 6897 ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr); 6898 ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr); 6899 for (i=0;i<n_V;i++) { 6900 PetscScalar val; 6901 PetscInt idx; 6902 6903 idx = idxs_V[i]; 6904 val = array[idxs_all[idxs_V[i]]]; 6905 ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr); 6906 } 6907 ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 6908 ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 6909 ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr); 6910 ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr); 6911 ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr); 6912 } 6913 sub_schurs->S_Ej_all = S_new; 6914 ierr = MatDestroy(&S_new);CHKERRQ(ierr); 6915 if (sub_schurs->sum_S_Ej_all) { 6916 ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr); 6917 ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr); 6918 ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr); 6919 if (pcbddc->deluxe_zerorows) { 6920 ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr); 6921 } 6922 sub_schurs->sum_S_Ej_all = S_new; 6923 ierr = MatDestroy(&S_new);CHKERRQ(ierr); 6924 } 6925 ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr); 6926 ierr = MatDestroy(&tmat);CHKERRQ(ierr); 6927 } 6928 /* destroy any change of basis context in sub_schurs */ 6929 if (sub_schurs && sub_schurs->change) { 6930 PetscInt i; 6931 6932 for (i=0;i<sub_schurs->n_subs;i++) { 6933 ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr); 6934 } 6935 ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr); 6936 } 6937 } 6938 if (pcbddc->switch_static) { /* need to save the local change */ 6939 pcbddc->switch_static_change = localChangeOfBasisMatrix; 6940 } else { 6941 ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr); 6942 } 6943 /* determine if any process has changed the pressures locally */ 6944 pcbddc->change_interior = pcbddc->benign_have_null; 6945 } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */ 6946 ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr); 6947 pcbddc->ConstraintMatrix = localChangeOfBasisMatrix; 6948 pcbddc->use_qr_single = qr_needed; 6949 } 6950 } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) { 6951 if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) { 6952 ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr); 6953 pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix; 6954 } else { 6955 Mat benign_global = NULL; 6956 if (pcbddc->benign_have_null) { 6957 Mat M; 6958 6959 pcbddc->change_interior = PETSC_TRUE; 6960 ierr = VecCopy(matis->counter,pcis->vec1_N);CHKERRQ(ierr); 6961 ierr = VecReciprocal(pcis->vec1_N);CHKERRQ(ierr); 6962 ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&benign_global);CHKERRQ(ierr); 6963 if (pcbddc->benign_change) { 6964 ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr); 6965 ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr); 6966 } else { 6967 ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&M);CHKERRQ(ierr); 6968 ierr = MatDiagonalSet(M,pcis->vec1_N,INSERT_VALUES);CHKERRQ(ierr); 6969 } 6970 ierr = MatISSetLocalMat(benign_global,M);CHKERRQ(ierr); 6971 ierr = MatDestroy(&M);CHKERRQ(ierr); 6972 ierr = MatAssemblyBegin(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 6973 ierr = MatAssemblyEnd(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 6974 } 6975 if (pcbddc->user_ChangeOfBasisMatrix) { 6976 ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr); 6977 ierr = MatDestroy(&benign_global);CHKERRQ(ierr); 6978 } else if (pcbddc->benign_have_null) { 6979 pcbddc->ChangeOfBasisMatrix = benign_global; 6980 } 6981 } 6982 if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */ 6983 IS is_global; 6984 const PetscInt *gidxs; 6985 6986 ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr); 6987 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr); 6988 ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr); 6989 ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr); 6990 ierr = ISDestroy(&is_global);CHKERRQ(ierr); 6991 } 6992 } 6993 if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) { 6994 ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr); 6995 } 6996 6997 if (!pcbddc->fake_change) { 6998 /* add pressure dofs to set of primal nodes for numbering purposes */ 6999 for (i=0;i<pcbddc->benign_n;i++) { 7000 pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i]; 7001 pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i]; 7002 pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1; 7003 pcbddc->local_primal_size_cc++; 7004 pcbddc->local_primal_size++; 7005 } 7006 7007 /* check if a new primal space has been introduced (also take into account benign trick) */ 7008 pcbddc->new_primal_space_local = PETSC_TRUE; 7009 if (olocal_primal_size == pcbddc->local_primal_size) { 7010 ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,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 if (!pcbddc->new_primal_space_local) { 7013 ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr); 7014 pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local); 7015 } 7016 } 7017 /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */ 7018 ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr); 7019 } 7020 ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr); 7021 7022 /* flush dbg viewer */ 7023 if (pcbddc->dbg_flag) { 7024 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 7025 } 7026 7027 /* free workspace */ 7028 ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr); 7029 ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr); 7030 if (!pcbddc->adaptive_selection) { 7031 ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr); 7032 ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr); 7033 } else { 7034 ierr = PetscFree5(pcbddc->adaptive_constraints_n, 7035 pcbddc->adaptive_constraints_idxs_ptr, 7036 pcbddc->adaptive_constraints_data_ptr, 7037 pcbddc->adaptive_constraints_idxs, 7038 pcbddc->adaptive_constraints_data);CHKERRQ(ierr); 7039 ierr = PetscFree(constraints_n);CHKERRQ(ierr); 7040 ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr); 7041 } 7042 PetscFunctionReturn(0); 7043 } 7044 /* #undef PETSC_MISSING_LAPACK_GESVD */ 7045 7046 PetscErrorCode PCBDDCAnalyzeInterface(PC pc) 7047 { 7048 ISLocalToGlobalMapping map; 7049 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 7050 Mat_IS *matis = (Mat_IS*)pc->pmat->data; 7051 PetscInt i,N; 7052 PetscBool rcsr = PETSC_FALSE; 7053 PetscErrorCode ierr; 7054 7055 PetscFunctionBegin; 7056 if (pcbddc->recompute_topography) { 7057 pcbddc->graphanalyzed = PETSC_FALSE; 7058 /* Reset previously computed graph */ 7059 ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr); 7060 /* Init local Graph struct */ 7061 ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr); 7062 ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr); 7063 ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr); 7064 7065 if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) { 7066 ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr); 7067 } 7068 /* Check validity of the csr graph passed in by the user */ 7069 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); 7070 7071 /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */ 7072 if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) { 7073 PetscInt *xadj,*adjncy; 7074 PetscInt nvtxs; 7075 PetscBool flg_row=PETSC_FALSE; 7076 7077 ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr); 7078 if (flg_row) { 7079 ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr); 7080 pcbddc->computed_rowadj = PETSC_TRUE; 7081 } 7082 ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr); 7083 rcsr = PETSC_TRUE; 7084 } 7085 if (pcbddc->dbg_flag) { 7086 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 7087 } 7088 7089 if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) { 7090 PetscReal *lcoords; 7091 PetscInt n; 7092 MPI_Datatype dimrealtype; 7093 7094 /* TODO: support for blocked */ 7095 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); 7096 ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr); 7097 ierr = PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords);CHKERRQ(ierr); 7098 ierr = MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype);CHKERRQ(ierr); 7099 ierr = MPI_Type_commit(&dimrealtype);CHKERRQ(ierr); 7100 ierr = PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr); 7101 ierr = PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr); 7102 ierr = MPI_Type_free(&dimrealtype);CHKERRQ(ierr); 7103 ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr); 7104 7105 pcbddc->mat_graph->coords = lcoords; 7106 pcbddc->mat_graph->cloc = PETSC_TRUE; 7107 pcbddc->mat_graph->cnloc = n; 7108 } 7109 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); 7110 pcbddc->mat_graph->active_coords = (PetscBool)(pcbddc->corner_selection && !pcbddc->corner_selected); 7111 7112 /* Setup of Graph */ 7113 pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */ 7114 ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr); 7115 7116 /* attach info on disconnected subdomains if present */ 7117 if (pcbddc->n_local_subs) { 7118 PetscInt *local_subs; 7119 7120 ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr); 7121 for (i=0;i<pcbddc->n_local_subs;i++) { 7122 const PetscInt *idxs; 7123 PetscInt nl,j; 7124 7125 ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr); 7126 ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr); 7127 for (j=0;j<nl;j++) local_subs[idxs[j]] = i; 7128 ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr); 7129 } 7130 pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs; 7131 pcbddc->mat_graph->local_subs = local_subs; 7132 } 7133 } 7134 7135 if (!pcbddc->graphanalyzed) { 7136 /* Graph's connected components analysis */ 7137 ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr); 7138 pcbddc->graphanalyzed = PETSC_TRUE; 7139 pcbddc->corner_selected = pcbddc->corner_selection; 7140 } 7141 if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0; 7142 PetscFunctionReturn(0); 7143 } 7144 7145 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[]) 7146 { 7147 PetscInt i,j; 7148 PetscScalar *alphas; 7149 PetscReal norm; 7150 PetscErrorCode ierr; 7151 7152 PetscFunctionBegin; 7153 if (!n) PetscFunctionReturn(0); 7154 ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr); 7155 ierr = VecNormalize(vecs[0],&norm);CHKERRQ(ierr); 7156 if (norm < PETSC_SMALL) { 7157 ierr = VecSet(vecs[0],0.0);CHKERRQ(ierr); 7158 } 7159 for (i=1;i<n;i++) { 7160 ierr = VecMDot(vecs[i],i,vecs,alphas);CHKERRQ(ierr); 7161 for (j=0;j<i;j++) alphas[j] = PetscConj(-alphas[j]); 7162 ierr = VecMAXPY(vecs[i],i,alphas,vecs);CHKERRQ(ierr); 7163 ierr = VecNormalize(vecs[i],&norm);CHKERRQ(ierr); 7164 if (norm < PETSC_SMALL) { 7165 ierr = VecSet(vecs[i],0.0);CHKERRQ(ierr); 7166 } 7167 } 7168 ierr = PetscFree(alphas);CHKERRQ(ierr); 7169 PetscFunctionReturn(0); 7170 } 7171 7172 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void) 7173 { 7174 Mat A; 7175 PetscInt n_neighs,*neighs,*n_shared,**shared; 7176 PetscMPIInt size,rank,color; 7177 PetscInt *xadj,*adjncy; 7178 PetscInt *adjncy_wgt,*v_wgt,*ranks_send_to_idx; 7179 PetscInt im_active,active_procs,N,n,i,j,threshold = 2; 7180 PetscInt void_procs,*procs_candidates = NULL; 7181 PetscInt xadj_count,*count; 7182 PetscBool ismatis,use_vwgt=PETSC_FALSE; 7183 PetscSubcomm psubcomm; 7184 MPI_Comm subcomm; 7185 PetscErrorCode ierr; 7186 7187 PetscFunctionBegin; 7188 PetscValidHeaderSpecific(mat,MAT_CLASSID,1); 7189 ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr); 7190 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); 7191 PetscValidLogicalCollectiveInt(mat,*n_subdomains,2); 7192 PetscValidLogicalCollectiveInt(mat,redprocs,3); 7193 if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %D",*n_subdomains); 7194 7195 if (have_void) *have_void = PETSC_FALSE; 7196 ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr); 7197 ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr); 7198 ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr); 7199 ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr); 7200 im_active = !!n; 7201 ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr); 7202 void_procs = size - active_procs; 7203 /* get ranks of of non-active processes in mat communicator */ 7204 if (void_procs) { 7205 PetscInt ncand; 7206 7207 if (have_void) *have_void = PETSC_TRUE; 7208 ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr); 7209 ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr); 7210 for (i=0,ncand=0;i<size;i++) { 7211 if (!procs_candidates[i]) { 7212 procs_candidates[ncand++] = i; 7213 } 7214 } 7215 /* force n_subdomains to be not greater that the number of non-active processes */ 7216 *n_subdomains = PetscMin(void_procs,*n_subdomains); 7217 } 7218 7219 /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix 7220 number of subdomains requested 1 -> send to master or first candidate in voids */ 7221 ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr); 7222 if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) { 7223 PetscInt issize,isidx,dest; 7224 if (*n_subdomains == 1) dest = 0; 7225 else dest = rank; 7226 if (im_active) { 7227 issize = 1; 7228 if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */ 7229 isidx = procs_candidates[dest]; 7230 } else { 7231 isidx = dest; 7232 } 7233 } else { 7234 issize = 0; 7235 isidx = -1; 7236 } 7237 if (*n_subdomains != 1) *n_subdomains = active_procs; 7238 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr); 7239 ierr = PetscFree(procs_candidates);CHKERRQ(ierr); 7240 PetscFunctionReturn(0); 7241 } 7242 ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr); 7243 ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr); 7244 threshold = PetscMax(threshold,2); 7245 7246 /* Get info on mapping */ 7247 ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr); 7248 7249 /* build local CSR graph of subdomains' connectivity */ 7250 ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr); 7251 xadj[0] = 0; 7252 xadj[1] = PetscMax(n_neighs-1,0); 7253 ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr); 7254 ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr); 7255 ierr = PetscCalloc1(n,&count);CHKERRQ(ierr); 7256 for (i=1;i<n_neighs;i++) 7257 for (j=0;j<n_shared[i];j++) 7258 count[shared[i][j]] += 1; 7259 7260 xadj_count = 0; 7261 for (i=1;i<n_neighs;i++) { 7262 for (j=0;j<n_shared[i];j++) { 7263 if (count[shared[i][j]] < threshold) { 7264 adjncy[xadj_count] = neighs[i]; 7265 adjncy_wgt[xadj_count] = n_shared[i]; 7266 xadj_count++; 7267 break; 7268 } 7269 } 7270 } 7271 xadj[1] = xadj_count; 7272 ierr = PetscFree(count);CHKERRQ(ierr); 7273 ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr); 7274 ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr); 7275 7276 ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr); 7277 7278 /* Restrict work on active processes only */ 7279 ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr); 7280 if (void_procs) { 7281 ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr); 7282 ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */ 7283 ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr); 7284 subcomm = PetscSubcommChild(psubcomm); 7285 } else { 7286 psubcomm = NULL; 7287 subcomm = PetscObjectComm((PetscObject)mat); 7288 } 7289 7290 v_wgt = NULL; 7291 if (!color) { 7292 ierr = PetscFree(xadj);CHKERRQ(ierr); 7293 ierr = PetscFree(adjncy);CHKERRQ(ierr); 7294 ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr); 7295 } else { 7296 Mat subdomain_adj; 7297 IS new_ranks,new_ranks_contig; 7298 MatPartitioning partitioner; 7299 PetscInt rstart=0,rend=0; 7300 PetscInt *is_indices,*oldranks; 7301 PetscMPIInt size; 7302 PetscBool aggregate; 7303 7304 ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr); 7305 if (void_procs) { 7306 PetscInt prank = rank; 7307 ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr); 7308 ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr); 7309 for (i=0;i<xadj[1];i++) { 7310 ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr); 7311 } 7312 ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr); 7313 } else { 7314 oldranks = NULL; 7315 } 7316 aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE); 7317 if (aggregate) { /* TODO: all this part could be made more efficient */ 7318 PetscInt lrows,row,ncols,*cols; 7319 PetscMPIInt nrank; 7320 PetscScalar *vals; 7321 7322 ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr); 7323 lrows = 0; 7324 if (nrank<redprocs) { 7325 lrows = size/redprocs; 7326 if (nrank<size%redprocs) lrows++; 7327 } 7328 ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr); 7329 ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr); 7330 ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr); 7331 ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr); 7332 row = nrank; 7333 ncols = xadj[1]-xadj[0]; 7334 cols = adjncy; 7335 ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr); 7336 for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i]; 7337 ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr); 7338 ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 7339 ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 7340 ierr = PetscFree(xadj);CHKERRQ(ierr); 7341 ierr = PetscFree(adjncy);CHKERRQ(ierr); 7342 ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr); 7343 ierr = PetscFree(vals);CHKERRQ(ierr); 7344 if (use_vwgt) { 7345 Vec v; 7346 const PetscScalar *array; 7347 PetscInt nl; 7348 7349 ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr); 7350 ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr); 7351 ierr = VecAssemblyBegin(v);CHKERRQ(ierr); 7352 ierr = VecAssemblyEnd(v);CHKERRQ(ierr); 7353 ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr); 7354 ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr); 7355 ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr); 7356 for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]); 7357 ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr); 7358 ierr = VecDestroy(&v);CHKERRQ(ierr); 7359 } 7360 } else { 7361 ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr); 7362 if (use_vwgt) { 7363 ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr); 7364 v_wgt[0] = n; 7365 } 7366 } 7367 /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */ 7368 7369 /* Partition */ 7370 ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr); 7371 #if defined(PETSC_HAVE_PTSCOTCH) 7372 ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPTSCOTCH);CHKERRQ(ierr); 7373 #elif defined(PETSC_HAVE_PARMETIS) 7374 ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPARMETIS);CHKERRQ(ierr); 7375 #else 7376 ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGAVERAGE);CHKERRQ(ierr); 7377 #endif 7378 ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr); 7379 if (v_wgt) { 7380 ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr); 7381 } 7382 *n_subdomains = PetscMin((PetscInt)size,*n_subdomains); 7383 ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr); 7384 ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr); 7385 ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr); 7386 /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */ 7387 7388 /* renumber new_ranks to avoid "holes" in new set of processors */ 7389 ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr); 7390 ierr = ISDestroy(&new_ranks);CHKERRQ(ierr); 7391 ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr); 7392 if (!aggregate) { 7393 if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */ 7394 #if defined(PETSC_USE_DEBUG) 7395 if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen"); 7396 #endif 7397 ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]]; 7398 } else if (oldranks) { 7399 ranks_send_to_idx[0] = oldranks[is_indices[0]]; 7400 } else { 7401 ranks_send_to_idx[0] = is_indices[0]; 7402 } 7403 } else { 7404 PetscInt idx = 0; 7405 PetscMPIInt tag; 7406 MPI_Request *reqs; 7407 7408 ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr); 7409 ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr); 7410 for (i=rstart;i<rend;i++) { 7411 ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr); 7412 } 7413 ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr); 7414 ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 7415 ierr = PetscFree(reqs);CHKERRQ(ierr); 7416 if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */ 7417 #if defined(PETSC_USE_DEBUG) 7418 if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen"); 7419 #endif 7420 ranks_send_to_idx[0] = procs_candidates[oldranks[idx]]; 7421 } else if (oldranks) { 7422 ranks_send_to_idx[0] = oldranks[idx]; 7423 } else { 7424 ranks_send_to_idx[0] = idx; 7425 } 7426 } 7427 ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr); 7428 /* clean up */ 7429 ierr = PetscFree(oldranks);CHKERRQ(ierr); 7430 ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr); 7431 ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr); 7432 ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr); 7433 } 7434 ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr); 7435 ierr = PetscFree(procs_candidates);CHKERRQ(ierr); 7436 7437 /* assemble parallel IS for sends */ 7438 i = 1; 7439 if (!color) i=0; 7440 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr); 7441 PetscFunctionReturn(0); 7442 } 7443 7444 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate; 7445 7446 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[]) 7447 { 7448 Mat local_mat; 7449 IS is_sends_internal; 7450 PetscInt rows,cols,new_local_rows; 7451 PetscInt i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs; 7452 PetscBool ismatis,isdense,newisdense,destroy_mat; 7453 ISLocalToGlobalMapping l2gmap; 7454 PetscInt* l2gmap_indices; 7455 const PetscInt* is_indices; 7456 MatType new_local_type; 7457 /* buffers */ 7458 PetscInt *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs; 7459 PetscInt *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is; 7460 PetscInt *recv_buffer_idxs_local; 7461 PetscScalar *ptr_vals,*recv_buffer_vals; 7462 const PetscScalar *send_buffer_vals; 7463 PetscScalar *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs; 7464 /* MPI */ 7465 MPI_Comm comm,comm_n; 7466 PetscSubcomm subcomm; 7467 PetscMPIInt n_sends,n_recvs,size; 7468 PetscMPIInt *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is; 7469 PetscMPIInt *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals; 7470 PetscMPIInt len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest; 7471 MPI_Request *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs; 7472 MPI_Request *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs; 7473 PetscErrorCode ierr; 7474 7475 PetscFunctionBegin; 7476 PetscValidHeaderSpecific(mat,MAT_CLASSID,1); 7477 ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr); 7478 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); 7479 PetscValidLogicalCollectiveInt(mat,n_subdomains,3); 7480 PetscValidLogicalCollectiveBool(mat,restrict_comm,4); 7481 PetscValidLogicalCollectiveBool(mat,restrict_full,5); 7482 PetscValidLogicalCollectiveBool(mat,reuse,6); 7483 PetscValidLogicalCollectiveInt(mat,nis,8); 7484 PetscValidLogicalCollectiveInt(mat,nvecs,10); 7485 if (nvecs) { 7486 if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported"); 7487 PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11); 7488 } 7489 /* further checks */ 7490 ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr); 7491 ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr); 7492 if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE"); 7493 ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr); 7494 if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square"); 7495 if (reuse && *mat_n) { 7496 PetscInt mrows,mcols,mnrows,mncols; 7497 PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7); 7498 ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr); 7499 if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS"); 7500 ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr); 7501 ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr); 7502 if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows); 7503 if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols); 7504 } 7505 ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr); 7506 PetscValidLogicalCollectiveInt(mat,bs,0); 7507 7508 /* prepare IS for sending if not provided */ 7509 if (!is_sends) { 7510 if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains"); 7511 ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr); 7512 } else { 7513 ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr); 7514 is_sends_internal = is_sends; 7515 } 7516 7517 /* get comm */ 7518 ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr); 7519 7520 /* compute number of sends */ 7521 ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr); 7522 ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr); 7523 7524 /* compute number of receives */ 7525 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 7526 ierr = PetscMalloc1(size,&iflags);CHKERRQ(ierr); 7527 ierr = PetscMemzero(iflags,size*sizeof(*iflags));CHKERRQ(ierr); 7528 ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr); 7529 for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1; 7530 ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr); 7531 ierr = PetscFree(iflags);CHKERRQ(ierr); 7532 7533 /* restrict comm if requested */ 7534 subcomm = 0; 7535 destroy_mat = PETSC_FALSE; 7536 if (restrict_comm) { 7537 PetscMPIInt color,subcommsize; 7538 7539 color = 0; 7540 if (restrict_full) { 7541 if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */ 7542 } else { 7543 if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */ 7544 } 7545 ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr); 7546 subcommsize = size - subcommsize; 7547 /* check if reuse has been requested */ 7548 if (reuse) { 7549 if (*mat_n) { 7550 PetscMPIInt subcommsize2; 7551 ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr); 7552 if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2); 7553 comm_n = PetscObjectComm((PetscObject)*mat_n); 7554 } else { 7555 comm_n = PETSC_COMM_SELF; 7556 } 7557 } else { /* MAT_INITIAL_MATRIX */ 7558 PetscMPIInt rank; 7559 7560 ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); 7561 ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr); 7562 ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); 7563 ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr); 7564 comm_n = PetscSubcommChild(subcomm); 7565 } 7566 /* flag to destroy *mat_n if not significative */ 7567 if (color) destroy_mat = PETSC_TRUE; 7568 } else { 7569 comm_n = comm; 7570 } 7571 7572 /* prepare send/receive buffers */ 7573 ierr = PetscMalloc1(size,&ilengths_idxs);CHKERRQ(ierr); 7574 ierr = PetscMemzero(ilengths_idxs,size*sizeof(*ilengths_idxs));CHKERRQ(ierr); 7575 ierr = PetscMalloc1(size,&ilengths_vals);CHKERRQ(ierr); 7576 ierr = PetscMemzero(ilengths_vals,size*sizeof(*ilengths_vals));CHKERRQ(ierr); 7577 if (nis) { 7578 ierr = PetscCalloc1(size,&ilengths_idxs_is);CHKERRQ(ierr); 7579 } 7580 7581 /* Get data from local matrices */ 7582 if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented"); 7583 /* TODO: See below some guidelines on how to prepare the local buffers */ 7584 /* 7585 send_buffer_vals should contain the raw values of the local matrix 7586 send_buffer_idxs should contain: 7587 - MatType_PRIVATE type 7588 - PetscInt size_of_l2gmap 7589 - PetscInt global_row_indices[size_of_l2gmap] 7590 - PetscInt all_other_info_which_is_needed_to_compute_preallocation_and_set_values 7591 */ 7592 else { 7593 ierr = MatDenseGetArrayRead(local_mat,&send_buffer_vals);CHKERRQ(ierr); 7594 ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr); 7595 ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr); 7596 send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE; 7597 send_buffer_idxs[1] = i; 7598 ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr); 7599 ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr); 7600 ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr); 7601 ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr); 7602 for (i=0;i<n_sends;i++) { 7603 ilengths_vals[is_indices[i]] = len*len; 7604 ilengths_idxs[is_indices[i]] = len+2; 7605 } 7606 } 7607 ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr); 7608 /* additional is (if any) */ 7609 if (nis) { 7610 PetscMPIInt psum; 7611 PetscInt j; 7612 for (j=0,psum=0;j<nis;j++) { 7613 PetscInt plen; 7614 ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr); 7615 ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr); 7616 psum += len+1; /* indices + lenght */ 7617 } 7618 ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr); 7619 for (j=0,psum=0;j<nis;j++) { 7620 PetscInt plen; 7621 const PetscInt *is_array_idxs; 7622 ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr); 7623 send_buffer_idxs_is[psum] = plen; 7624 ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr); 7625 ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr); 7626 ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr); 7627 psum += plen+1; /* indices + lenght */ 7628 } 7629 for (i=0;i<n_sends;i++) { 7630 ilengths_idxs_is[is_indices[i]] = psum; 7631 } 7632 ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr); 7633 } 7634 ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr); 7635 7636 buf_size_idxs = 0; 7637 buf_size_vals = 0; 7638 buf_size_idxs_is = 0; 7639 buf_size_vecs = 0; 7640 for (i=0;i<n_recvs;i++) { 7641 buf_size_idxs += (PetscInt)olengths_idxs[i]; 7642 buf_size_vals += (PetscInt)olengths_vals[i]; 7643 if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i]; 7644 if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i]; 7645 } 7646 ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr); 7647 ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr); 7648 ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr); 7649 ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr); 7650 7651 /* get new tags for clean communications */ 7652 ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr); 7653 ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr); 7654 ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr); 7655 ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr); 7656 7657 /* allocate for requests */ 7658 ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr); 7659 ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr); 7660 ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr); 7661 ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr); 7662 ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr); 7663 ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr); 7664 ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr); 7665 ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr); 7666 7667 /* communications */ 7668 ptr_idxs = recv_buffer_idxs; 7669 ptr_vals = recv_buffer_vals; 7670 ptr_idxs_is = recv_buffer_idxs_is; 7671 ptr_vecs = recv_buffer_vecs; 7672 for (i=0;i<n_recvs;i++) { 7673 source_dest = onodes[i]; 7674 ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr); 7675 ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr); 7676 ptr_idxs += olengths_idxs[i]; 7677 ptr_vals += olengths_vals[i]; 7678 if (nis) { 7679 source_dest = onodes_is[i]; 7680 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); 7681 ptr_idxs_is += olengths_idxs_is[i]; 7682 } 7683 if (nvecs) { 7684 source_dest = onodes[i]; 7685 ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr); 7686 ptr_vecs += olengths_idxs[i]-2; 7687 } 7688 } 7689 for (i=0;i<n_sends;i++) { 7690 ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr); 7691 ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr); 7692 ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr); 7693 if (nis) { 7694 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); 7695 } 7696 if (nvecs) { 7697 ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr); 7698 ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr); 7699 } 7700 } 7701 ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr); 7702 ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr); 7703 7704 /* assemble new l2g map */ 7705 ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 7706 ptr_idxs = recv_buffer_idxs; 7707 new_local_rows = 0; 7708 for (i=0;i<n_recvs;i++) { 7709 new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */ 7710 ptr_idxs += olengths_idxs[i]; 7711 } 7712 ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr); 7713 ptr_idxs = recv_buffer_idxs; 7714 new_local_rows = 0; 7715 for (i=0;i<n_recvs;i++) { 7716 ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr); 7717 new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */ 7718 ptr_idxs += olengths_idxs[i]; 7719 } 7720 ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr); 7721 ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr); 7722 ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr); 7723 7724 /* infer new local matrix type from received local matrices type */ 7725 /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */ 7726 /* 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) */ 7727 if (n_recvs) { 7728 MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0]; 7729 ptr_idxs = recv_buffer_idxs; 7730 for (i=0;i<n_recvs;i++) { 7731 if ((PetscInt)new_local_type_private != *ptr_idxs) { 7732 new_local_type_private = MATAIJ_PRIVATE; 7733 break; 7734 } 7735 ptr_idxs += olengths_idxs[i]; 7736 } 7737 switch (new_local_type_private) { 7738 case MATDENSE_PRIVATE: 7739 new_local_type = MATSEQAIJ; 7740 bs = 1; 7741 break; 7742 case MATAIJ_PRIVATE: 7743 new_local_type = MATSEQAIJ; 7744 bs = 1; 7745 break; 7746 case MATBAIJ_PRIVATE: 7747 new_local_type = MATSEQBAIJ; 7748 break; 7749 case MATSBAIJ_PRIVATE: 7750 new_local_type = MATSEQSBAIJ; 7751 break; 7752 default: 7753 SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME); 7754 break; 7755 } 7756 } else { /* by default, new_local_type is seqaij */ 7757 new_local_type = MATSEQAIJ; 7758 bs = 1; 7759 } 7760 7761 /* create MATIS object if needed */ 7762 if (!reuse) { 7763 ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr); 7764 ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr); 7765 } else { 7766 /* it also destroys the local matrices */ 7767 if (*mat_n) { 7768 ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr); 7769 } else { /* this is a fake object */ 7770 ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr); 7771 } 7772 } 7773 ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr); 7774 ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr); 7775 7776 ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 7777 7778 /* Global to local map of received indices */ 7779 ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */ 7780 ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr); 7781 ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr); 7782 7783 /* restore attributes -> type of incoming data and its size */ 7784 buf_size_idxs = 0; 7785 for (i=0;i<n_recvs;i++) { 7786 recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs]; 7787 recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1]; 7788 buf_size_idxs += (PetscInt)olengths_idxs[i]; 7789 } 7790 ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr); 7791 7792 /* set preallocation */ 7793 ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr); 7794 if (!newisdense) { 7795 PetscInt *new_local_nnz=0; 7796 7797 ptr_idxs = recv_buffer_idxs_local; 7798 if (n_recvs) { 7799 ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr); 7800 } 7801 for (i=0;i<n_recvs;i++) { 7802 PetscInt j; 7803 if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */ 7804 for (j=0;j<*(ptr_idxs+1);j++) { 7805 new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1); 7806 } 7807 } else { 7808 /* TODO */ 7809 } 7810 ptr_idxs += olengths_idxs[i]; 7811 } 7812 if (new_local_nnz) { 7813 for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows); 7814 ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr); 7815 for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs; 7816 ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr); 7817 for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0); 7818 ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr); 7819 } else { 7820 ierr = MatSetUp(local_mat);CHKERRQ(ierr); 7821 } 7822 ierr = PetscFree(new_local_nnz);CHKERRQ(ierr); 7823 } else { 7824 ierr = MatSetUp(local_mat);CHKERRQ(ierr); 7825 } 7826 7827 /* set values */ 7828 ptr_vals = recv_buffer_vals; 7829 ptr_idxs = recv_buffer_idxs_local; 7830 for (i=0;i<n_recvs;i++) { 7831 if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */ 7832 ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr); 7833 ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr); 7834 ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr); 7835 ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr); 7836 ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr); 7837 } else { 7838 /* TODO */ 7839 } 7840 ptr_idxs += olengths_idxs[i]; 7841 ptr_vals += olengths_vals[i]; 7842 } 7843 ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 7844 ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 7845 ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr); 7846 ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 7847 ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 7848 ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr); 7849 7850 #if 0 7851 if (!restrict_comm) { /* check */ 7852 Vec lvec,rvec; 7853 PetscReal infty_error; 7854 7855 ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr); 7856 ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr); 7857 ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr); 7858 ierr = VecScale(lvec,-1.0);CHKERRQ(ierr); 7859 ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr); 7860 ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr); 7861 ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error); 7862 ierr = VecDestroy(&rvec);CHKERRQ(ierr); 7863 ierr = VecDestroy(&lvec);CHKERRQ(ierr); 7864 } 7865 #endif 7866 7867 /* assemble new additional is (if any) */ 7868 if (nis) { 7869 PetscInt **temp_idxs,*count_is,j,psum; 7870 7871 ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 7872 ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr); 7873 ptr_idxs = recv_buffer_idxs_is; 7874 psum = 0; 7875 for (i=0;i<n_recvs;i++) { 7876 for (j=0;j<nis;j++) { 7877 PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */ 7878 count_is[j] += plen; /* increment counting of buffer for j-th IS */ 7879 psum += plen; 7880 ptr_idxs += plen+1; /* shift pointer to received data */ 7881 } 7882 } 7883 ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr); 7884 ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr); 7885 for (i=1;i<nis;i++) { 7886 temp_idxs[i] = temp_idxs[i-1]+count_is[i-1]; 7887 } 7888 ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr); 7889 ptr_idxs = recv_buffer_idxs_is; 7890 for (i=0;i<n_recvs;i++) { 7891 for (j=0;j<nis;j++) { 7892 PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */ 7893 ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr); 7894 count_is[j] += plen; /* increment starting point of buffer for j-th IS */ 7895 ptr_idxs += plen+1; /* shift pointer to received data */ 7896 } 7897 } 7898 for (i=0;i<nis;i++) { 7899 ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr); 7900 ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr); 7901 ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr); 7902 } 7903 ierr = PetscFree(count_is);CHKERRQ(ierr); 7904 ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr); 7905 ierr = PetscFree(temp_idxs);CHKERRQ(ierr); 7906 } 7907 /* free workspace */ 7908 ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr); 7909 ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 7910 ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr); 7911 ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 7912 if (isdense) { 7913 ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr); 7914 ierr = MatDenseRestoreArrayRead(local_mat,&send_buffer_vals);CHKERRQ(ierr); 7915 ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr); 7916 } else { 7917 /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */ 7918 } 7919 if (nis) { 7920 ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 7921 ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr); 7922 } 7923 7924 if (nvecs) { 7925 ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 7926 ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr); 7927 ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr); 7928 ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr); 7929 ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr); 7930 ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr); 7931 ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr); 7932 /* set values */ 7933 ptr_vals = recv_buffer_vecs; 7934 ptr_idxs = recv_buffer_idxs_local; 7935 ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr); 7936 for (i=0;i<n_recvs;i++) { 7937 PetscInt j; 7938 for (j=0;j<*(ptr_idxs+1);j++) { 7939 send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j); 7940 } 7941 ptr_idxs += olengths_idxs[i]; 7942 ptr_vals += olengths_idxs[i]-2; 7943 } 7944 ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr); 7945 ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr); 7946 ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr); 7947 } 7948 7949 ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr); 7950 ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr); 7951 ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr); 7952 ierr = PetscFree(recv_req_vals);CHKERRQ(ierr); 7953 ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr); 7954 ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr); 7955 ierr = PetscFree(send_req_idxs);CHKERRQ(ierr); 7956 ierr = PetscFree(send_req_vals);CHKERRQ(ierr); 7957 ierr = PetscFree(send_req_vecs);CHKERRQ(ierr); 7958 ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr); 7959 ierr = PetscFree(ilengths_vals);CHKERRQ(ierr); 7960 ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr); 7961 ierr = PetscFree(olengths_vals);CHKERRQ(ierr); 7962 ierr = PetscFree(olengths_idxs);CHKERRQ(ierr); 7963 ierr = PetscFree(onodes);CHKERRQ(ierr); 7964 if (nis) { 7965 ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr); 7966 ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr); 7967 ierr = PetscFree(onodes_is);CHKERRQ(ierr); 7968 } 7969 ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr); 7970 if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */ 7971 ierr = MatDestroy(mat_n);CHKERRQ(ierr); 7972 for (i=0;i<nis;i++) { 7973 ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr); 7974 } 7975 if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */ 7976 ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr); 7977 } 7978 *mat_n = NULL; 7979 } 7980 PetscFunctionReturn(0); 7981 } 7982 7983 /* temporary hack into ksp private data structure */ 7984 #include <petsc/private/kspimpl.h> 7985 7986 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals) 7987 { 7988 PC_BDDC *pcbddc = (PC_BDDC*)pc->data; 7989 PC_IS *pcis = (PC_IS*)pc->data; 7990 Mat coarse_mat,coarse_mat_is,coarse_submat_dense; 7991 Mat coarsedivudotp = NULL; 7992 Mat coarseG,t_coarse_mat_is; 7993 MatNullSpace CoarseNullSpace = NULL; 7994 ISLocalToGlobalMapping coarse_islg; 7995 IS coarse_is,*isarray,corners; 7996 PetscInt i,im_active=-1,active_procs=-1; 7997 PetscInt nis,nisdofs,nisneu,nisvert; 7998 PetscInt coarse_eqs_per_proc; 7999 PC pc_temp; 8000 PCType coarse_pc_type; 8001 KSPType coarse_ksp_type; 8002 PetscBool multilevel_requested,multilevel_allowed; 8003 PetscBool coarse_reuse; 8004 PetscInt ncoarse,nedcfield; 8005 PetscBool compute_vecs = PETSC_FALSE; 8006 PetscScalar *array; 8007 MatReuse coarse_mat_reuse; 8008 PetscBool restr, full_restr, have_void; 8009 PetscMPIInt size; 8010 PetscErrorCode ierr; 8011 8012 PetscFunctionBegin; 8013 ierr = PetscLogEventBegin(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr); 8014 /* Assign global numbering to coarse dofs */ 8015 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 */ 8016 PetscInt ocoarse_size; 8017 compute_vecs = PETSC_TRUE; 8018 8019 pcbddc->new_primal_space = PETSC_TRUE; 8020 ocoarse_size = pcbddc->coarse_size; 8021 ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr); 8022 ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr); 8023 /* see if we can avoid some work */ 8024 if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */ 8025 /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */ 8026 if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) { 8027 ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr); 8028 coarse_reuse = PETSC_FALSE; 8029 } else { /* we can safely reuse already computed coarse matrix */ 8030 coarse_reuse = PETSC_TRUE; 8031 } 8032 } else { /* there's no coarse ksp, so we need to create the coarse matrix too */ 8033 coarse_reuse = PETSC_FALSE; 8034 } 8035 /* reset any subassembling information */ 8036 if (!coarse_reuse || pcbddc->recompute_topography) { 8037 ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr); 8038 } 8039 } else { /* primal space is unchanged, so we can reuse coarse matrix */ 8040 coarse_reuse = PETSC_TRUE; 8041 } 8042 if (coarse_reuse && pcbddc->coarse_ksp) { 8043 ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr); 8044 ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr); 8045 coarse_mat_reuse = MAT_REUSE_MATRIX; 8046 } else { 8047 coarse_mat = NULL; 8048 coarse_mat_reuse = MAT_INITIAL_MATRIX; 8049 } 8050 8051 /* creates temporary l2gmap and IS for coarse indexes */ 8052 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr); 8053 ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr); 8054 8055 /* creates temporary MATIS object for coarse matrix */ 8056 ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr); 8057 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); 8058 ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr); 8059 ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 8060 ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 8061 ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr); 8062 8063 /* count "active" (i.e. with positive local size) and "void" processes */ 8064 im_active = !!(pcis->n); 8065 ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr); 8066 8067 /* determine number of processes partecipating to coarse solver and compute subassembling pattern */ 8068 /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */ 8069 /* full_restr : just use the receivers from the subassembling pattern */ 8070 ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr); 8071 coarse_mat_is = NULL; 8072 multilevel_allowed = PETSC_FALSE; 8073 multilevel_requested = PETSC_FALSE; 8074 coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc); 8075 if (coarse_eqs_per_proc < 0) coarse_eqs_per_proc = pcbddc->coarse_size; 8076 if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE; 8077 if (pcbddc->coarse_size <= pcbddc->coarse_eqs_limit) multilevel_requested = PETSC_FALSE; 8078 if (multilevel_requested) { 8079 ncoarse = active_procs/pcbddc->coarsening_ratio; 8080 restr = PETSC_FALSE; 8081 full_restr = PETSC_FALSE; 8082 } else { 8083 ncoarse = pcbddc->coarse_size/coarse_eqs_per_proc + !!(pcbddc->coarse_size%coarse_eqs_per_proc); 8084 restr = PETSC_TRUE; 8085 full_restr = PETSC_TRUE; 8086 } 8087 if (!pcbddc->coarse_size || size == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE; 8088 ncoarse = PetscMax(1,ncoarse); 8089 if (!pcbddc->coarse_subassembling) { 8090 if (pcbddc->coarsening_ratio > 1) { 8091 if (multilevel_requested) { 8092 ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr); 8093 } else { 8094 ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr); 8095 } 8096 } else { 8097 PetscMPIInt rank; 8098 ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr); 8099 have_void = (active_procs == (PetscInt)size) ? PETSC_FALSE : PETSC_TRUE; 8100 ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr); 8101 } 8102 } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */ 8103 PetscInt psum; 8104 if (pcbddc->coarse_ksp) psum = 1; 8105 else psum = 0; 8106 ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr); 8107 have_void = ncoarse < size ? PETSC_TRUE : PETSC_FALSE; 8108 } 8109 /* determine if we can go multilevel */ 8110 if (multilevel_requested) { 8111 if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */ 8112 else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */ 8113 } 8114 if (multilevel_allowed && have_void) restr = PETSC_TRUE; 8115 8116 /* dump subassembling pattern */ 8117 if (pcbddc->dbg_flag && multilevel_allowed) { 8118 ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr); 8119 } 8120 /* compute dofs splitting and neumann boundaries for coarse dofs */ 8121 nedcfield = -1; 8122 corners = NULL; 8123 if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal || pcbddc->corner_selected)) { /* protects from unneded computations */ 8124 PetscInt *tidxs,*tidxs2,nout,tsize,i; 8125 const PetscInt *idxs; 8126 ISLocalToGlobalMapping tmap; 8127 8128 /* create map between primal indices (in local representative ordering) and local primal numbering */ 8129 ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr); 8130 /* allocate space for temporary storage */ 8131 ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr); 8132 ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr); 8133 /* allocate for IS array */ 8134 nisdofs = pcbddc->n_ISForDofsLocal; 8135 if (pcbddc->nedclocal) { 8136 if (pcbddc->nedfield > -1) { 8137 nedcfield = pcbddc->nedfield; 8138 } else { 8139 nedcfield = 0; 8140 if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%D)",nisdofs); 8141 nisdofs = 1; 8142 } 8143 } 8144 nisneu = !!pcbddc->NeumannBoundariesLocal; 8145 nisvert = 0; /* nisvert is not used */ 8146 nis = nisdofs + nisneu + nisvert; 8147 ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr); 8148 /* dofs splitting */ 8149 for (i=0;i<nisdofs;i++) { 8150 /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */ 8151 if (nedcfield != i) { 8152 ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr); 8153 ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr); 8154 ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr); 8155 ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr); 8156 } else { 8157 ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr); 8158 ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr); 8159 ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr); 8160 if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %D != %D",tsize,nout); 8161 ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr); 8162 } 8163 ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr); 8164 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr); 8165 /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */ 8166 } 8167 /* neumann boundaries */ 8168 if (pcbddc->NeumannBoundariesLocal) { 8169 /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */ 8170 ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr); 8171 ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr); 8172 ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr); 8173 ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr); 8174 ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr); 8175 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr); 8176 /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */ 8177 } 8178 /* coordinates */ 8179 if (pcbddc->corner_selected) { 8180 ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr); 8181 ierr = ISGetLocalSize(corners,&tsize);CHKERRQ(ierr); 8182 ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr); 8183 ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr); 8184 if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping corners! %D != %D",tsize,nout); 8185 ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr); 8186 ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr); 8187 ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr); 8188 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&corners);CHKERRQ(ierr); 8189 } 8190 ierr = PetscFree(tidxs);CHKERRQ(ierr); 8191 ierr = PetscFree(tidxs2);CHKERRQ(ierr); 8192 ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr); 8193 } else { 8194 nis = 0; 8195 nisdofs = 0; 8196 nisneu = 0; 8197 nisvert = 0; 8198 isarray = NULL; 8199 } 8200 /* destroy no longer needed map */ 8201 ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr); 8202 8203 /* subassemble */ 8204 if (multilevel_allowed) { 8205 Vec vp[1]; 8206 PetscInt nvecs = 0; 8207 PetscBool reuse,reuser; 8208 8209 if (coarse_mat) reuse = PETSC_TRUE; 8210 else reuse = PETSC_FALSE; 8211 ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr); 8212 vp[0] = NULL; 8213 if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */ 8214 ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr); 8215 ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr); 8216 ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr); 8217 nvecs = 1; 8218 8219 if (pcbddc->divudotp) { 8220 Mat B,loc_divudotp; 8221 Vec v,p; 8222 IS dummy; 8223 PetscInt np; 8224 8225 ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr); 8226 ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr); 8227 ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr); 8228 ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr); 8229 ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr); 8230 ierr = VecSet(p,1.);CHKERRQ(ierr); 8231 ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr); 8232 ierr = VecDestroy(&p);CHKERRQ(ierr); 8233 ierr = MatDestroy(&B);CHKERRQ(ierr); 8234 ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr); 8235 ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr); 8236 ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr); 8237 ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr); 8238 ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr); 8239 ierr = ISDestroy(&dummy);CHKERRQ(ierr); 8240 ierr = VecDestroy(&v);CHKERRQ(ierr); 8241 } 8242 } 8243 if (reuser) { 8244 ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr); 8245 } else { 8246 ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr); 8247 } 8248 if (vp[0]) { /* vp[0] could have been placed on a different set of processes */ 8249 PetscScalar *arraym; 8250 const PetscScalar *arrayv; 8251 PetscInt nl; 8252 ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr); 8253 ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr); 8254 ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr); 8255 ierr = VecGetArrayRead(vp[0],&arrayv);CHKERRQ(ierr); 8256 ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr); 8257 ierr = VecRestoreArrayRead(vp[0],&arrayv);CHKERRQ(ierr); 8258 ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr); 8259 ierr = VecDestroy(&vp[0]);CHKERRQ(ierr); 8260 } else { 8261 ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr); 8262 } 8263 } else { 8264 ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr); 8265 } 8266 if (coarse_mat_is || coarse_mat) { 8267 if (!multilevel_allowed) { 8268 ierr = MatConvert(coarse_mat_is,MATAIJ,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr); 8269 } else { 8270 Mat A; 8271 8272 /* if this matrix is present, it means we are not reusing the coarse matrix */ 8273 if (coarse_mat_is) { 8274 if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen"); 8275 ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr); 8276 coarse_mat = coarse_mat_is; 8277 } 8278 /* be sure we don't have MatSeqDENSE as local mat */ 8279 ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr); 8280 ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr); 8281 } 8282 } 8283 ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr); 8284 ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr); 8285 8286 /* create local to global scatters for coarse problem */ 8287 if (compute_vecs) { 8288 PetscInt lrows; 8289 ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr); 8290 if (coarse_mat) { 8291 ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr); 8292 } else { 8293 lrows = 0; 8294 } 8295 ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr); 8296 ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr); 8297 ierr = VecSetType(pcbddc->coarse_vec,coarse_mat ? coarse_mat->defaultvectype : VECSTANDARD);CHKERRQ(ierr); 8298 ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr); 8299 ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr); 8300 } 8301 ierr = ISDestroy(&coarse_is);CHKERRQ(ierr); 8302 8303 /* set defaults for coarse KSP and PC */ 8304 if (multilevel_allowed) { 8305 coarse_ksp_type = KSPRICHARDSON; 8306 coarse_pc_type = PCBDDC; 8307 } else { 8308 coarse_ksp_type = KSPPREONLY; 8309 coarse_pc_type = PCREDUNDANT; 8310 } 8311 8312 /* print some info if requested */ 8313 if (pcbddc->dbg_flag) { 8314 if (!multilevel_allowed) { 8315 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr); 8316 if (multilevel_requested) { 8317 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); 8318 } else if (pcbddc->max_levels) { 8319 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%D)\n",pcbddc->max_levels);CHKERRQ(ierr); 8320 } 8321 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 8322 } 8323 } 8324 8325 /* communicate coarse discrete gradient */ 8326 coarseG = NULL; 8327 if (pcbddc->nedcG && multilevel_allowed) { 8328 MPI_Comm ccomm; 8329 if (coarse_mat) { 8330 ccomm = PetscObjectComm((PetscObject)coarse_mat); 8331 } else { 8332 ccomm = MPI_COMM_NULL; 8333 } 8334 ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr); 8335 } 8336 8337 /* create the coarse KSP object only once with defaults */ 8338 if (coarse_mat) { 8339 PetscBool isredundant,isnn,isbddc; 8340 PetscViewer dbg_viewer = NULL; 8341 8342 if (pcbddc->dbg_flag) { 8343 dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat)); 8344 ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr); 8345 } 8346 if (!pcbddc->coarse_ksp) { 8347 char prefix[256],str_level[16]; 8348 size_t len; 8349 8350 ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr); 8351 ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr); 8352 ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr); 8353 ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr); 8354 ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr); 8355 ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr); 8356 ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr); 8357 ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr); 8358 /* TODO is this logic correct? should check for coarse_mat type */ 8359 ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr); 8360 /* prefix */ 8361 ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr); 8362 ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr); 8363 if (!pcbddc->current_level) { 8364 ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,sizeof(prefix));CHKERRQ(ierr); 8365 ierr = PetscStrlcat(prefix,"pc_bddc_coarse_",sizeof(prefix));CHKERRQ(ierr); 8366 } else { 8367 ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr); 8368 if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */ 8369 if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */ 8370 /* Nonstandard use of PetscStrncpy() to copy only a portion of the string */ 8371 ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr); 8372 ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr); 8373 ierr = PetscStrlcat(prefix,str_level,sizeof(prefix));CHKERRQ(ierr); 8374 } 8375 ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr); 8376 /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */ 8377 ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr); 8378 ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr); 8379 ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr); 8380 /* allow user customization */ 8381 ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr); 8382 /* get some info after set from options */ 8383 ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr); 8384 /* multilevel cannot be done with coarse PCs different from BDDC or NN */ 8385 ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr); 8386 ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr); 8387 if (multilevel_allowed && !isbddc && !isnn) { 8388 isbddc = PETSC_TRUE; 8389 ierr = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr); 8390 ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr); 8391 ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr); 8392 ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr); 8393 if (pc_temp->ops->setfromoptions) { /* need to setfromoptions again, skipping the pc_type */ 8394 ierr = PetscObjectOptionsBegin((PetscObject)pc_temp);CHKERRQ(ierr); 8395 ierr = (*pc_temp->ops->setfromoptions)(PetscOptionsObject,pc_temp);CHKERRQ(ierr); 8396 ierr = PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject)pc_temp);CHKERRQ(ierr); 8397 ierr = PetscOptionsEnd();CHKERRQ(ierr); 8398 pc_temp->setfromoptionscalled++; 8399 } 8400 } 8401 } 8402 /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */ 8403 ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr); 8404 if (nisdofs) { 8405 ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr); 8406 for (i=0;i<nisdofs;i++) { 8407 ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr); 8408 } 8409 } 8410 if (nisneu) { 8411 ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr); 8412 ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr); 8413 } 8414 if (nisvert) { 8415 ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr); 8416 ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr); 8417 } 8418 if (coarseG) { 8419 ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr); 8420 } 8421 8422 /* get some info after set from options */ 8423 ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr); 8424 8425 /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */ 8426 if (isbddc && !multilevel_allowed) { 8427 ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr); 8428 isbddc = PETSC_FALSE; 8429 } 8430 /* multilevel cannot be done with coarse PCs different from BDDC or NN */ 8431 ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr); 8432 if (multilevel_requested && multilevel_allowed && !isbddc && !isnn) { 8433 ierr = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr); 8434 isbddc = PETSC_TRUE; 8435 } 8436 ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr); 8437 if (isredundant) { 8438 KSP inner_ksp; 8439 PC inner_pc; 8440 8441 ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr); 8442 ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr); 8443 } 8444 8445 /* parameters which miss an API */ 8446 ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr); 8447 if (isbddc) { 8448 PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data; 8449 8450 pcbddc_coarse->detect_disconnected = PETSC_TRUE; 8451 pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc; 8452 pcbddc_coarse->coarse_eqs_limit = pcbddc->coarse_eqs_limit; 8453 pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null; 8454 if (pcbddc_coarse->benign_saddle_point) { 8455 Mat coarsedivudotp_is; 8456 ISLocalToGlobalMapping l2gmap,rl2g,cl2g; 8457 IS row,col; 8458 const PetscInt *gidxs; 8459 PetscInt n,st,M,N; 8460 8461 ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr); 8462 ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr); 8463 st = st-n; 8464 ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr); 8465 ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr); 8466 ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr); 8467 ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr); 8468 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr); 8469 ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr); 8470 ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr); 8471 ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr); 8472 ierr = ISGetSize(row,&M);CHKERRQ(ierr); 8473 ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr); 8474 ierr = ISDestroy(&row);CHKERRQ(ierr); 8475 ierr = ISDestroy(&col);CHKERRQ(ierr); 8476 ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr); 8477 ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr); 8478 ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr); 8479 ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr); 8480 ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr); 8481 ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr); 8482 ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr); 8483 ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr); 8484 ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr); 8485 ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr); 8486 pcbddc_coarse->adaptive_userdefined = PETSC_TRUE; 8487 if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE; 8488 } 8489 } 8490 8491 /* propagate symmetry info of coarse matrix */ 8492 ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr); 8493 if (pc->pmat->symmetric_set) { 8494 ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr); 8495 } 8496 if (pc->pmat->hermitian_set) { 8497 ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr); 8498 } 8499 if (pc->pmat->spd_set) { 8500 ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr); 8501 } 8502 if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) { 8503 ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr); 8504 } 8505 /* set operators */ 8506 ierr = MatViewFromOptions(coarse_mat,(PetscObject)pc,"-pc_bddc_coarse_mat_view");CHKERRQ(ierr); 8507 ierr = MatSetOptionsPrefix(coarse_mat,((PetscObject)pcbddc->coarse_ksp)->prefix);CHKERRQ(ierr); 8508 ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr); 8509 if (pcbddc->dbg_flag) { 8510 ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr); 8511 } 8512 } 8513 ierr = MatDestroy(&coarseG);CHKERRQ(ierr); 8514 ierr = PetscFree(isarray);CHKERRQ(ierr); 8515 #if 0 8516 { 8517 PetscViewer viewer; 8518 char filename[256]; 8519 sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level); 8520 ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr); 8521 ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr); 8522 ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr); 8523 ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr); 8524 ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); 8525 } 8526 #endif 8527 8528 if (corners) { 8529 Vec gv; 8530 IS is; 8531 const PetscInt *idxs; 8532 PetscInt i,d,N,n,cdim = pcbddc->mat_graph->cdim; 8533 PetscScalar *coords; 8534 8535 if (!pcbddc->mat_graph->cloc) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Missing local coordinates"); 8536 ierr = VecGetSize(pcbddc->coarse_vec,&N);CHKERRQ(ierr); 8537 ierr = VecGetLocalSize(pcbddc->coarse_vec,&n);CHKERRQ(ierr); 8538 ierr = VecCreate(PetscObjectComm((PetscObject)pcbddc->coarse_vec),&gv);CHKERRQ(ierr); 8539 ierr = VecSetBlockSize(gv,cdim);CHKERRQ(ierr); 8540 ierr = VecSetSizes(gv,n*cdim,N*cdim);CHKERRQ(ierr); 8541 ierr = VecSetType(gv,VECSTANDARD);CHKERRQ(ierr); 8542 ierr = VecSetFromOptions(gv);CHKERRQ(ierr); 8543 ierr = VecSet(gv,PETSC_MAX_REAL);CHKERRQ(ierr); /* we only propagate coordinates from vertices constraints */ 8544 8545 ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr); 8546 ierr = ISGetLocalSize(is,&n);CHKERRQ(ierr); 8547 ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr); 8548 ierr = PetscMalloc1(n*cdim,&coords);CHKERRQ(ierr); 8549 for (i=0;i<n;i++) { 8550 for (d=0;d<cdim;d++) { 8551 coords[cdim*i+d] = pcbddc->mat_graph->coords[cdim*idxs[i]+d]; 8552 } 8553 } 8554 ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr); 8555 ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr); 8556 8557 ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr); 8558 ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr); 8559 ierr = VecSetValuesBlocked(gv,n,idxs,coords,INSERT_VALUES);CHKERRQ(ierr); 8560 ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr); 8561 ierr = PetscFree(coords);CHKERRQ(ierr); 8562 ierr = VecAssemblyBegin(gv);CHKERRQ(ierr); 8563 ierr = VecAssemblyEnd(gv);CHKERRQ(ierr); 8564 ierr = VecGetArray(gv,&coords);CHKERRQ(ierr); 8565 if (pcbddc->coarse_ksp) { 8566 PC coarse_pc; 8567 PetscBool isbddc; 8568 8569 ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr); 8570 ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr); 8571 if (isbddc) { /* coarse coordinates have PETSC_MAX_REAL, specific for BDDC */ 8572 PetscReal *realcoords; 8573 8574 ierr = VecGetLocalSize(gv,&n);CHKERRQ(ierr); 8575 #if defined(PETSC_USE_COMPLEX) 8576 ierr = PetscMalloc1(n,&realcoords);CHKERRQ(ierr); 8577 for (i=0;i<n;i++) realcoords[i] = PetscRealPart(coords[i]); 8578 #else 8579 realcoords = coords; 8580 #endif 8581 ierr = PCSetCoordinates(coarse_pc,cdim,n/cdim,realcoords);CHKERRQ(ierr); 8582 #if defined(PETSC_USE_COMPLEX) 8583 ierr = PetscFree(realcoords);CHKERRQ(ierr); 8584 #endif 8585 } 8586 } 8587 ierr = VecRestoreArray(gv,&coords);CHKERRQ(ierr); 8588 ierr = VecDestroy(&gv);CHKERRQ(ierr); 8589 } 8590 ierr = ISDestroy(&corners);CHKERRQ(ierr); 8591 8592 if (pcbddc->coarse_ksp) { 8593 Vec crhs,csol; 8594 8595 ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr); 8596 ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr); 8597 if (!csol) { 8598 ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr); 8599 } 8600 if (!crhs) { 8601 ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr); 8602 } 8603 } 8604 ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr); 8605 8606 /* compute null space for coarse solver if the benign trick has been requested */ 8607 if (pcbddc->benign_null) { 8608 8609 ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr); 8610 for (i=0;i<pcbddc->benign_n;i++) { 8611 ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr); 8612 } 8613 ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr); 8614 ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr); 8615 ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 8616 ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 8617 if (coarse_mat) { 8618 Vec nullv; 8619 PetscScalar *array,*array2; 8620 PetscInt nl; 8621 8622 ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr); 8623 ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr); 8624 ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr); 8625 ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr); 8626 ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr); 8627 ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr); 8628 ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr); 8629 ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr); 8630 ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr); 8631 ierr = VecDestroy(&nullv);CHKERRQ(ierr); 8632 } 8633 } 8634 ierr = PetscLogEventEnd(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr); 8635 8636 ierr = PetscLogEventBegin(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr); 8637 if (pcbddc->coarse_ksp) { 8638 PetscBool ispreonly; 8639 8640 if (CoarseNullSpace) { 8641 PetscBool isnull; 8642 ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr); 8643 if (isnull) { 8644 ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr); 8645 } 8646 /* TODO: add local nullspaces (if any) */ 8647 } 8648 /* setup coarse ksp */ 8649 ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr); 8650 /* Check coarse problem if in debug mode or if solving with an iterative method */ 8651 ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr); 8652 if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) { 8653 KSP check_ksp; 8654 KSPType check_ksp_type; 8655 PC check_pc; 8656 Vec check_vec,coarse_vec; 8657 PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0; 8658 PetscInt its; 8659 PetscBool compute_eigs; 8660 PetscReal *eigs_r,*eigs_c; 8661 PetscInt neigs; 8662 const char *prefix; 8663 8664 /* Create ksp object suitable for estimation of extreme eigenvalues */ 8665 ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr); 8666 ierr = PetscObjectIncrementTabLevel((PetscObject)check_ksp,(PetscObject)pcbddc->coarse_ksp,0);CHKERRQ(ierr); 8667 ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,PETSC_FALSE);CHKERRQ(ierr); 8668 ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr); 8669 ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr); 8670 /* prevent from setup unneeded object */ 8671 ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr); 8672 ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr); 8673 if (ispreonly) { 8674 check_ksp_type = KSPPREONLY; 8675 compute_eigs = PETSC_FALSE; 8676 } else { 8677 check_ksp_type = KSPGMRES; 8678 compute_eigs = PETSC_TRUE; 8679 } 8680 ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr); 8681 ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr); 8682 ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr); 8683 ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr); 8684 ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr); 8685 ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr); 8686 ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr); 8687 ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr); 8688 ierr = KSPSetUp(check_ksp);CHKERRQ(ierr); 8689 ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr); 8690 ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr); 8691 /* create random vec */ 8692 ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr); 8693 ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr); 8694 ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr); 8695 /* solve coarse problem */ 8696 ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr); 8697 ierr = KSPCheckSolve(check_ksp,pc,coarse_vec);CHKERRQ(ierr); 8698 /* set eigenvalue estimation if preonly has not been requested */ 8699 if (compute_eigs) { 8700 ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr); 8701 ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr); 8702 ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr); 8703 if (neigs) { 8704 lambda_max = eigs_r[neigs-1]; 8705 lambda_min = eigs_r[0]; 8706 if (pcbddc->use_coarse_estimates) { 8707 if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */ 8708 ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr); 8709 ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr); 8710 } 8711 } 8712 } 8713 } 8714 8715 /* check coarse problem residual error */ 8716 if (pcbddc->dbg_flag) { 8717 PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp)); 8718 ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr); 8719 ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr); 8720 ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr); 8721 ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr); 8722 ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr); 8723 ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr); 8724 ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr); 8725 ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr); 8726 ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error : %1.6e\n",infty_error);CHKERRQ(ierr); 8727 ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr); 8728 if (CoarseNullSpace) { 8729 ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr); 8730 } 8731 if (compute_eigs) { 8732 PetscReal lambda_max_s,lambda_min_s; 8733 KSPConvergedReason reason; 8734 ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr); 8735 ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr); 8736 ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr); 8737 ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr); 8738 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); 8739 for (i=0;i<neigs;i++) { 8740 ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr); 8741 } 8742 } 8743 ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr); 8744 ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr); 8745 } 8746 ierr = VecDestroy(&check_vec);CHKERRQ(ierr); 8747 ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr); 8748 ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr); 8749 if (compute_eigs) { 8750 ierr = PetscFree(eigs_r);CHKERRQ(ierr); 8751 ierr = PetscFree(eigs_c);CHKERRQ(ierr); 8752 } 8753 } 8754 } 8755 ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr); 8756 /* print additional info */ 8757 if (pcbddc->dbg_flag) { 8758 /* waits until all processes reaches this point */ 8759 ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr); 8760 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %D\n",pcbddc->current_level);CHKERRQ(ierr); 8761 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 8762 } 8763 8764 /* free memory */ 8765 ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr); 8766 ierr = PetscLogEventEnd(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr); 8767 PetscFunctionReturn(0); 8768 } 8769 8770 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n) 8771 { 8772 PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 8773 PC_IS* pcis = (PC_IS*)pc->data; 8774 Mat_IS* matis = (Mat_IS*)pc->pmat->data; 8775 IS subset,subset_mult,subset_n; 8776 PetscInt local_size,coarse_size=0; 8777 PetscInt *local_primal_indices=NULL; 8778 const PetscInt *t_local_primal_indices; 8779 PetscErrorCode ierr; 8780 8781 PetscFunctionBegin; 8782 /* Compute global number of coarse dofs */ 8783 if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first"); 8784 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr); 8785 ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr); 8786 ierr = ISDestroy(&subset_n);CHKERRQ(ierr); 8787 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr); 8788 ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr); 8789 ierr = ISDestroy(&subset);CHKERRQ(ierr); 8790 ierr = ISDestroy(&subset_mult);CHKERRQ(ierr); 8791 ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr); 8792 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); 8793 ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr); 8794 ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr); 8795 ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr); 8796 ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr); 8797 ierr = ISDestroy(&subset_n);CHKERRQ(ierr); 8798 8799 /* check numbering */ 8800 if (pcbddc->dbg_flag) { 8801 PetscScalar coarsesum,*array,*array2; 8802 PetscInt i; 8803 PetscBool set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE; 8804 8805 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 8806 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr); 8807 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr); 8808 ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr); 8809 /* counter */ 8810 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 8811 ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr); 8812 ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 8813 ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 8814 ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 8815 ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 8816 ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr); 8817 for (i=0;i<pcbddc->local_primal_size;i++) { 8818 ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr); 8819 } 8820 ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr); 8821 ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr); 8822 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 8823 ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 8824 ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 8825 ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 8826 ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 8827 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 8828 ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr); 8829 for (i=0;i<pcis->n;i++) { 8830 if (array[i] != 0.0 && array[i] != array2[i]) { 8831 PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi; 8832 PetscInt neigh = (PetscInt)PetscRealPart(array2[i]); 8833 set_error = PETSC_TRUE; 8834 ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr); 8835 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); 8836 } 8837 } 8838 ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr); 8839 ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr); 8840 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 8841 for (i=0;i<pcis->n;i++) { 8842 if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]); 8843 } 8844 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 8845 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 8846 ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 8847 ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 8848 ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr); 8849 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %D (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr); 8850 if (pcbddc->dbg_flag > 1 || set_error_reduced) { 8851 PetscInt *gidxs; 8852 8853 ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr); 8854 ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr); 8855 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr); 8856 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 8857 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr); 8858 for (i=0;i<pcbddc->local_primal_size;i++) { 8859 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); 8860 } 8861 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 8862 ierr = PetscFree(gidxs);CHKERRQ(ierr); 8863 } 8864 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 8865 ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr); 8866 if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed"); 8867 } 8868 8869 /* get back data */ 8870 *coarse_size_n = coarse_size; 8871 *local_primal_indices_n = local_primal_indices; 8872 PetscFunctionReturn(0); 8873 } 8874 8875 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis) 8876 { 8877 IS localis_t; 8878 PetscInt i,lsize,*idxs,n; 8879 PetscScalar *vals; 8880 PetscErrorCode ierr; 8881 8882 PetscFunctionBegin; 8883 /* get indices in local ordering exploiting local to global map */ 8884 ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr); 8885 ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr); 8886 for (i=0;i<lsize;i++) vals[i] = 1.0; 8887 ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr); 8888 ierr = VecSet(gwork,0.0);CHKERRQ(ierr); 8889 ierr = VecSet(lwork,0.0);CHKERRQ(ierr); 8890 if (idxs) { /* multilevel guard */ 8891 ierr = VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE);CHKERRQ(ierr); 8892 ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr); 8893 } 8894 ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr); 8895 ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr); 8896 ierr = PetscFree(vals);CHKERRQ(ierr); 8897 ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr); 8898 /* now compute set in local ordering */ 8899 ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 8900 ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 8901 ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr); 8902 ierr = VecGetSize(lwork,&n);CHKERRQ(ierr); 8903 for (i=0,lsize=0;i<n;i++) { 8904 if (PetscRealPart(vals[i]) > 0.5) { 8905 lsize++; 8906 } 8907 } 8908 ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr); 8909 for (i=0,lsize=0;i<n;i++) { 8910 if (PetscRealPart(vals[i]) > 0.5) { 8911 idxs[lsize++] = i; 8912 } 8913 } 8914 ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr); 8915 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr); 8916 *localis = localis_t; 8917 PetscFunctionReturn(0); 8918 } 8919 8920 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc) 8921 { 8922 PC_IS *pcis=(PC_IS*)pc->data; 8923 PC_BDDC *pcbddc=(PC_BDDC*)pc->data; 8924 PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs; 8925 Mat S_j; 8926 PetscInt *used_xadj,*used_adjncy; 8927 PetscBool free_used_adj; 8928 PetscErrorCode ierr; 8929 8930 PetscFunctionBegin; 8931 ierr = PetscLogEventBegin(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr); 8932 /* decide the adjacency to be used for determining internal problems for local schur on subsets */ 8933 free_used_adj = PETSC_FALSE; 8934 if (pcbddc->sub_schurs_layers == -1) { 8935 used_xadj = NULL; 8936 used_adjncy = NULL; 8937 } else { 8938 if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) { 8939 used_xadj = pcbddc->mat_graph->xadj; 8940 used_adjncy = pcbddc->mat_graph->adjncy; 8941 } else if (pcbddc->computed_rowadj) { 8942 used_xadj = pcbddc->mat_graph->xadj; 8943 used_adjncy = pcbddc->mat_graph->adjncy; 8944 } else { 8945 PetscBool flg_row=PETSC_FALSE; 8946 const PetscInt *xadj,*adjncy; 8947 PetscInt nvtxs; 8948 8949 ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr); 8950 if (flg_row) { 8951 ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr); 8952 ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr); 8953 ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr); 8954 free_used_adj = PETSC_TRUE; 8955 } else { 8956 pcbddc->sub_schurs_layers = -1; 8957 used_xadj = NULL; 8958 used_adjncy = NULL; 8959 } 8960 ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr); 8961 } 8962 } 8963 8964 /* setup sub_schurs data */ 8965 ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr); 8966 if (!sub_schurs->schur_explicit) { 8967 /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */ 8968 ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr); 8969 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); 8970 } else { 8971 Mat change = NULL; 8972 Vec scaling = NULL; 8973 IS change_primal = NULL, iP; 8974 PetscInt benign_n; 8975 PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis; 8976 PetscBool isseqaij,need_change = PETSC_FALSE; 8977 PetscBool discrete_harmonic = PETSC_FALSE; 8978 8979 if (!pcbddc->use_vertices && reuse_solvers) { 8980 PetscInt n_vertices; 8981 8982 ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr); 8983 reuse_solvers = (PetscBool)!n_vertices; 8984 } 8985 ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr); 8986 if (!isseqaij) { 8987 Mat_IS* matis = (Mat_IS*)pc->pmat->data; 8988 if (matis->A == pcbddc->local_mat) { 8989 ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr); 8990 ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr); 8991 } else { 8992 ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr); 8993 } 8994 } 8995 if (!pcbddc->benign_change_explicit) { 8996 benign_n = pcbddc->benign_n; 8997 } else { 8998 benign_n = 0; 8999 } 9000 /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc. 9001 We need a global reduction to avoid possible deadlocks. 9002 We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */ 9003 if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) { 9004 PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change); 9005 ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr); 9006 need_change = (PetscBool)(!need_change); 9007 } 9008 /* If the user defines additional constraints, we import them here. 9009 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 */ 9010 if (need_change) { 9011 PC_IS *pcisf; 9012 PC_BDDC *pcbddcf; 9013 PC pcf; 9014 9015 if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph"); 9016 ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr); 9017 ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr); 9018 ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr); 9019 9020 /* hacks */ 9021 pcisf = (PC_IS*)pcf->data; 9022 pcisf->is_B_local = pcis->is_B_local; 9023 pcisf->vec1_N = pcis->vec1_N; 9024 pcisf->BtoNmap = pcis->BtoNmap; 9025 pcisf->n = pcis->n; 9026 pcisf->n_B = pcis->n_B; 9027 pcbddcf = (PC_BDDC*)pcf->data; 9028 ierr = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr); 9029 pcbddcf->mat_graph = pcbddc->mat_graph; 9030 pcbddcf->use_faces = PETSC_TRUE; 9031 pcbddcf->use_change_of_basis = PETSC_TRUE; 9032 pcbddcf->use_change_on_faces = PETSC_TRUE; 9033 pcbddcf->use_qr_single = PETSC_TRUE; 9034 pcbddcf->fake_change = PETSC_TRUE; 9035 9036 /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */ 9037 ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr); 9038 sub_schurs->change_with_qr = pcbddcf->use_qr_single; 9039 ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr); 9040 change = pcbddcf->ConstraintMatrix; 9041 pcbddcf->ConstraintMatrix = NULL; 9042 9043 /* free unneeded memory allocated in PCBDDCConstraintsSetUp */ 9044 ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr); 9045 ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr); 9046 ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr); 9047 ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr); 9048 ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr); 9049 ierr = PetscFree(pcf->data);CHKERRQ(ierr); 9050 pcf->ops->destroy = NULL; 9051 pcf->ops->reset = NULL; 9052 ierr = PCDestroy(&pcf);CHKERRQ(ierr); 9053 } 9054 if (!pcbddc->use_deluxe_scaling) scaling = pcis->D; 9055 9056 ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr); 9057 if (iP) { 9058 ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr); 9059 ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr); 9060 ierr = PetscOptionsEnd();CHKERRQ(ierr); 9061 } 9062 if (discrete_harmonic) { 9063 Mat A; 9064 ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr); 9065 ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr); 9066 ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr); 9067 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); 9068 ierr = MatDestroy(&A);CHKERRQ(ierr); 9069 } else { 9070 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); 9071 } 9072 ierr = MatDestroy(&change);CHKERRQ(ierr); 9073 ierr = ISDestroy(&change_primal);CHKERRQ(ierr); 9074 } 9075 ierr = MatDestroy(&S_j);CHKERRQ(ierr); 9076 9077 /* free adjacency */ 9078 if (free_used_adj) { 9079 ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr); 9080 } 9081 ierr = PetscLogEventEnd(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr); 9082 PetscFunctionReturn(0); 9083 } 9084 9085 PetscErrorCode PCBDDCInitSubSchurs(PC pc) 9086 { 9087 PC_IS *pcis=(PC_IS*)pc->data; 9088 PC_BDDC *pcbddc=(PC_BDDC*)pc->data; 9089 PCBDDCGraph graph; 9090 PetscErrorCode ierr; 9091 9092 PetscFunctionBegin; 9093 /* attach interface graph for determining subsets */ 9094 if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */ 9095 IS verticesIS,verticescomm; 9096 PetscInt vsize,*idxs; 9097 9098 ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr); 9099 ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr); 9100 ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr); 9101 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr); 9102 ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr); 9103 ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr); 9104 ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr); 9105 ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr); 9106 ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr); 9107 ierr = ISDestroy(&verticescomm);CHKERRQ(ierr); 9108 ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr); 9109 } else { 9110 graph = pcbddc->mat_graph; 9111 } 9112 /* print some info */ 9113 if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) { 9114 IS vertices; 9115 PetscInt nv,nedges,nfaces; 9116 ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr); 9117 ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr); 9118 ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr); 9119 ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr); 9120 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr); 9121 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,(int)nv,pcbddc->use_vertices);CHKERRQ(ierr); 9122 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges (%D)\n",PetscGlobalRank,(int)nedges,pcbddc->use_edges);CHKERRQ(ierr); 9123 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces (%D)\n",PetscGlobalRank,(int)nfaces,pcbddc->use_faces);CHKERRQ(ierr); 9124 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 9125 ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr); 9126 ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr); 9127 } 9128 9129 /* sub_schurs init */ 9130 if (!pcbddc->sub_schurs) { 9131 ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr); 9132 } 9133 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); 9134 9135 /* free graph struct */ 9136 if (pcbddc->sub_schurs_rebuild) { 9137 ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr); 9138 } 9139 PetscFunctionReturn(0); 9140 } 9141 9142 PetscErrorCode PCBDDCCheckOperator(PC pc) 9143 { 9144 PC_IS *pcis=(PC_IS*)pc->data; 9145 PC_BDDC *pcbddc=(PC_BDDC*)pc->data; 9146 PetscErrorCode ierr; 9147 9148 PetscFunctionBegin; 9149 if (pcbddc->n_vertices == pcbddc->local_primal_size) { 9150 IS zerodiag = NULL; 9151 Mat S_j,B0_B=NULL; 9152 Vec dummy_vec=NULL,vec_check_B,vec_scale_P; 9153 PetscScalar *p0_check,*array,*array2; 9154 PetscReal norm; 9155 PetscInt i; 9156 9157 /* B0 and B0_B */ 9158 if (zerodiag) { 9159 IS dummy; 9160 9161 ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr); 9162 ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr); 9163 ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr); 9164 ierr = ISDestroy(&dummy);CHKERRQ(ierr); 9165 } 9166 /* I need a primal vector to scale primal nodes since BDDC sums contibutions */ 9167 ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr); 9168 ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr); 9169 ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 9170 ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 9171 ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 9172 ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 9173 ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr); 9174 /* S_j */ 9175 ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr); 9176 ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr); 9177 9178 /* mimic vector in \widetilde{W}_\Gamma */ 9179 ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr); 9180 /* continuous in primal space */ 9181 ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr); 9182 ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 9183 ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 9184 ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 9185 ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr); 9186 for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i]; 9187 ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr); 9188 ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 9189 ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr); 9190 ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr); 9191 ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 9192 ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 9193 ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr); 9194 ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr); 9195 9196 /* assemble rhs for coarse problem */ 9197 /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */ 9198 /* local with Schur */ 9199 ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr); 9200 if (zerodiag) { 9201 ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr); 9202 for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i]; 9203 ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr); 9204 ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr); 9205 } 9206 /* sum on primal nodes the local contributions */ 9207 ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 9208 ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 9209 ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr); 9210 ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr); 9211 for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]]; 9212 ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr); 9213 ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr); 9214 ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr); 9215 ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 9216 ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 9217 ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 9218 ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 9219 ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 9220 /* scale primal nodes (BDDC sums contibutions) */ 9221 ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr); 9222 ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr); 9223 ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr); 9224 ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr); 9225 ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr); 9226 ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 9227 ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 9228 /* global: \widetilde{B0}_B w_\Gamma */ 9229 if (zerodiag) { 9230 ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr); 9231 ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr); 9232 for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i]; 9233 ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr); 9234 } 9235 /* BDDC */ 9236 ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr); 9237 ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr); 9238 9239 ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr); 9240 ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr); 9241 ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr); 9242 ierr = PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);CHKERRQ(ierr); 9243 for (i=0;i<pcbddc->benign_n;i++) { 9244 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); 9245 } 9246 ierr = PetscFree(p0_check);CHKERRQ(ierr); 9247 ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr); 9248 ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr); 9249 ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr); 9250 ierr = MatDestroy(&S_j);CHKERRQ(ierr); 9251 ierr = MatDestroy(&B0_B);CHKERRQ(ierr); 9252 } 9253 PetscFunctionReturn(0); 9254 } 9255 9256 #include <../src/mat/impls/aij/mpi/mpiaij.h> 9257 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B) 9258 { 9259 Mat At; 9260 IS rows; 9261 PetscInt rst,ren; 9262 PetscErrorCode ierr; 9263 PetscLayout rmap; 9264 9265 PetscFunctionBegin; 9266 rst = ren = 0; 9267 if (ccomm != MPI_COMM_NULL) { 9268 ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr); 9269 ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr); 9270 ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr); 9271 ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr); 9272 ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr); 9273 } 9274 ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr); 9275 ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr); 9276 ierr = ISDestroy(&rows);CHKERRQ(ierr); 9277 9278 if (ccomm != MPI_COMM_NULL) { 9279 Mat_MPIAIJ *a,*b; 9280 IS from,to; 9281 Vec gvec; 9282 PetscInt lsize; 9283 9284 ierr = MatCreate(ccomm,B);CHKERRQ(ierr); 9285 ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr); 9286 ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr); 9287 ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr); 9288 ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr); 9289 a = (Mat_MPIAIJ*)At->data; 9290 b = (Mat_MPIAIJ*)(*B)->data; 9291 ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr); 9292 ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr); 9293 ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr); 9294 ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr); 9295 b->A = a->A; 9296 b->B = a->B; 9297 9298 b->donotstash = a->donotstash; 9299 b->roworiented = a->roworiented; 9300 b->rowindices = 0; 9301 b->rowvalues = 0; 9302 b->getrowactive = PETSC_FALSE; 9303 9304 (*B)->rmap = rmap; 9305 (*B)->factortype = A->factortype; 9306 (*B)->assembled = PETSC_TRUE; 9307 (*B)->insertmode = NOT_SET_VALUES; 9308 (*B)->preallocated = PETSC_TRUE; 9309 9310 if (a->colmap) { 9311 #if defined(PETSC_USE_CTABLE) 9312 ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr); 9313 #else 9314 ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr); 9315 ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr); 9316 ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr); 9317 #endif 9318 } else b->colmap = 0; 9319 if (a->garray) { 9320 PetscInt len; 9321 len = a->B->cmap->n; 9322 ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr); 9323 ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr); 9324 if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); } 9325 } else b->garray = 0; 9326 9327 ierr = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr); 9328 b->lvec = a->lvec; 9329 ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr); 9330 9331 /* cannot use VecScatterCopy */ 9332 ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr); 9333 ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr); 9334 ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr); 9335 ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr); 9336 ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr); 9337 ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr); 9338 ierr = ISDestroy(&from);CHKERRQ(ierr); 9339 ierr = ISDestroy(&to);CHKERRQ(ierr); 9340 ierr = VecDestroy(&gvec);CHKERRQ(ierr); 9341 } 9342 ierr = MatDestroy(&At);CHKERRQ(ierr); 9343 PetscFunctionReturn(0); 9344 } 9345