Actual source code: pcis.c

  1: #define PETSCKSP_DLL

 3:  #include src/ksp/pc/impls/is/pcis.h

  5: /* -------------------------------------------------------------------------- */
  6: /*
  7:    PCISSetUp - 
  8: */
 11: PetscErrorCode PETSCKSP_DLLEXPORT PCISSetUp(PC pc)
 12: {
 13:   PC_IS           *pcis = (PC_IS*)(pc->data);
 14:   Mat_IS          *matis = (Mat_IS*)pc->mat->data;
 15:   PetscInt        i;
 16:   PetscErrorCode  ierr;
 17:   PetscTruth      flg;
 18: 
 20:   PetscTypeCompare((PetscObject)pc->mat,MATIS,&flg);
 21:   if (!flg){
 22:     SETERRQ(PETSC_ERR_ARG_WRONG,"Preconditioner type of Neumann Neumman requires matrix of type MATIS");
 23:   }

 25:   pcis->pure_neumann = matis->pure_neumann;

 27:   /*
 28:     Creating the local vector vec1_N, containing the inverse of the number
 29:     of subdomains to which each local node (either owned or ghost)
 30:     pertains. To accomplish that, we scatter local vectors of 1's to
 31:     a global vector (adding the values); scatter the result back to
 32:     local vectors and finally invert the result.
 33:   */
 34:   {
 35:     Vec    counter;
 36:     VecDuplicate(matis->x,&pcis->vec1_N);
 37:     MatGetVecs(pc->pmat,&counter,0); /* temporary auxiliar vector */
 38:     VecSet(counter,0.0);
 39:     VecSet(pcis->vec1_N,1.0);
 40:     VecScatterBegin(pcis->vec1_N,counter,ADD_VALUES,SCATTER_REVERSE,matis->ctx);
 41:     VecScatterEnd  (pcis->vec1_N,counter,ADD_VALUES,SCATTER_REVERSE,matis->ctx);
 42:     VecScatterBegin(counter,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD,matis->ctx);
 43:     VecScatterEnd  (counter,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD,matis->ctx);
 44:     VecDestroy(counter);
 45:   }
 46:   /*
 47:     Creating local and global index sets for interior and
 48:     inteface nodes. Notice that interior nodes have D[i]==1.0.
 49:   */
 50:   {
 51:     PetscInt     n_I;
 52:     PetscInt    *idx_I_local,*idx_B_local,*idx_I_global,*idx_B_global;
 53:     PetscScalar *array;
 54:     /* Identifying interior and interface nodes, in local numbering */
 55:     VecGetSize(pcis->vec1_N,&pcis->n);
 56:     VecGetArray(pcis->vec1_N,&array);
 57:     PetscMalloc(pcis->n*sizeof(PetscInt),&idx_I_local);
 58:     PetscMalloc(pcis->n*sizeof(PetscInt),&idx_B_local);
 59:     for (i=0, pcis->n_B=0, n_I=0; i<pcis->n; i++) {
 60:       if (array[i] == 1.0) { idx_I_local[n_I]       = i; n_I++;       }
 61:       else                 { idx_B_local[pcis->n_B] = i; pcis->n_B++; }
 62:     }
 63:     /* Getting the global numbering */
 64:     idx_B_global = idx_I_local + n_I; /* Just avoiding allocating extra memory, since we have vacant space */
 65:     idx_I_global = idx_B_local + pcis->n_B;
 66:     ISLocalToGlobalMappingApply(matis->mapping,pcis->n_B,idx_B_local,idx_B_global);
 67:     ISLocalToGlobalMappingApply(matis->mapping,n_I,      idx_I_local,idx_I_global);
 68:     /* Creating the index sets. */
 69:     ISCreateGeneral(MPI_COMM_SELF,pcis->n_B,idx_B_local, &pcis->is_B_local);
 70:     ISCreateGeneral(MPI_COMM_SELF,pcis->n_B,idx_B_global,&pcis->is_B_global);
 71:     ISCreateGeneral(MPI_COMM_SELF,n_I      ,idx_I_local, &pcis->is_I_local);
 72:     ISCreateGeneral(MPI_COMM_SELF,n_I      ,idx_I_global,&pcis->is_I_global);
 73:     /* Freeing memory and restoring arrays */
 74:     PetscFree(idx_B_local);
 75:     PetscFree(idx_I_local);
 76:     VecRestoreArray(pcis->vec1_N,&array);
 77:   }

 79:   /*
 80:     Extracting the blocks A_II, A_BI, A_IB and A_BB from A. If the numbering
 81:     is such that interior nodes come first than the interface ones, we have

 83:     [           |      ]
 84:     [    A_II   | A_IB ]
 85:     A = [           |      ]
 86:     [-----------+------]
 87:     [    A_BI   | A_BB ]
 88:   */

 90:   MatGetSubMatrix(matis->A,pcis->is_I_local,pcis->is_I_local,PETSC_DECIDE,MAT_INITIAL_MATRIX,&pcis->A_II);
 91:   MatGetSubMatrix(matis->A,pcis->is_I_local,pcis->is_B_local,PETSC_DECIDE,MAT_INITIAL_MATRIX,&pcis->A_IB);
 92:   MatGetSubMatrix(matis->A,pcis->is_B_local,pcis->is_I_local,PETSC_DECIDE,MAT_INITIAL_MATRIX,&pcis->A_BI);
 93:   MatGetSubMatrix(matis->A,pcis->is_B_local,pcis->is_B_local,PETSC_DECIDE,MAT_INITIAL_MATRIX,&pcis->A_BB);

 95:   /*
 96:     Creating work vectors and arrays
 97:   */
 98:   /* pcis->vec1_N has already been created */
 99:   VecDuplicate(pcis->vec1_N,&pcis->vec2_N);
100:   VecCreateSeq(PETSC_COMM_SELF,pcis->n-pcis->n_B,&pcis->vec1_D);
101:   VecDuplicate(pcis->vec1_D,&pcis->vec2_D);
102:   VecDuplicate(pcis->vec1_D,&pcis->vec3_D);
103:   VecCreateSeq(PETSC_COMM_SELF,pcis->n_B,&pcis->vec1_B);
104:   VecDuplicate(pcis->vec1_B,&pcis->vec2_B);
105:   VecDuplicate(pcis->vec1_B,&pcis->vec3_B);
106:   MatGetVecs(pc->pmat,&pcis->vec1_global,0);
107:   PetscMalloc((pcis->n)*sizeof(PetscScalar),&pcis->work_N);

109:   /* Creating the scatter contexts */
110:   VecScatterCreate(pcis->vec1_global,pcis->is_I_global,pcis->vec1_D,(IS)0,&pcis->global_to_D);
111:   VecScatterCreate(pcis->vec1_N,pcis->is_B_local,pcis->vec1_B,(IS)0,&pcis->N_to_B);
112:   VecScatterCreate(pcis->vec1_global,pcis->is_B_global,pcis->vec1_B,(IS)0,&pcis->global_to_B);

114:   /* Creating scaling "matrix" D, from information in vec1_N */
115:   VecDuplicate(pcis->vec1_B,&pcis->D);
116:   VecScatterBegin(pcis->vec1_N,pcis->D,INSERT_VALUES,SCATTER_FORWARD,pcis->N_to_B);
117:   VecScatterEnd  (pcis->vec1_N,pcis->D,INSERT_VALUES,SCATTER_FORWARD,pcis->N_to_B);
118:   VecReciprocal(pcis->D);

120:   /* See historical note 01, at the bottom of this file. */

122:   /*
123:     Creating the KSP contexts for the local Dirichlet and Neumann problems.
124:   */
125:   {
126:     PC  pc_ctx;
127:     /* Dirichlet */
128:     KSPCreate(PETSC_COMM_SELF,&pcis->ksp_D);
129:     KSPSetOperators(pcis->ksp_D,pcis->A_II,pcis->A_II,SAME_PRECONDITIONER);
130:     KSPSetOptionsPrefix(pcis->ksp_D,"is_localD_");
131:     KSPGetPC(pcis->ksp_D,&pc_ctx);
132:     PCSetType(pc_ctx,PCLU);
133:     KSPSetType(pcis->ksp_D,KSPPREONLY);
134:     KSPSetFromOptions(pcis->ksp_D);
135:     /* the vectors in the following line are dummy arguments, just telling the KSP the vector size. Values are not used */
136:     KSPSetUp(pcis->ksp_D);
137:     /* Neumann */
138:     KSPCreate(PETSC_COMM_SELF,&pcis->ksp_N);
139:     KSPSetOperators(pcis->ksp_N,matis->A,matis->A,SAME_PRECONDITIONER);
140:     KSPSetOptionsPrefix(pcis->ksp_N,"is_localN_");
141:     KSPGetPC(pcis->ksp_N,&pc_ctx);
142:     PCSetType(pc_ctx,PCLU);
143:     KSPSetType(pcis->ksp_N,KSPPREONLY);
144:     KSPSetFromOptions(pcis->ksp_N);
145:     {
146:       PetscTruth damp_fixed,
147:                  remove_nullspace_fixed,
148:                  set_damping_factor_floating,
149:                  not_damp_floating,
150:                  not_remove_nullspace_floating;
151:       PetscReal  fixed_factor,
152:                  floating_factor;

154:       PetscOptionsGetReal(pc_ctx->prefix,"-pc_is_damp_fixed",&fixed_factor,&damp_fixed);
155:       if (!damp_fixed) { fixed_factor = 0.0; }
156:       PetscOptionsHasName(pc_ctx->prefix,"-pc_is_damp_fixed",&damp_fixed);

158:       PetscOptionsHasName(pc_ctx->prefix,"-pc_is_remove_nullspace_fixed",&remove_nullspace_fixed);

160:       PetscOptionsGetReal(pc_ctx->prefix,"-pc_is_set_damping_factor_floating",
161:                               &floating_factor,&set_damping_factor_floating);
162:       if (!set_damping_factor_floating) { floating_factor = 0.0; }
163:       PetscOptionsHasName(pc_ctx->prefix,"-pc_is_set_damping_factor_floating",&set_damping_factor_floating);
164:       if (!set_damping_factor_floating) { floating_factor = 1.e-12; }

166:       PetscOptionsHasName(pc_ctx->prefix,"-pc_is_not_damp_floating",&not_damp_floating);

168:       PetscOptionsHasName(pc_ctx->prefix,"-pc_is_not_remove_nullspace_floating",&not_remove_nullspace_floating);

170:       if (pcis->pure_neumann) {  /* floating subdomain */
171:         if (!(not_damp_floating)) {
172:           PCFactorSetShiftNonzero(pc_ctx,floating_factor);
173:         }
174:         if (!(not_remove_nullspace_floating)){
175:           MatNullSpace nullsp;
176:           MatNullSpaceCreate(PETSC_COMM_SELF,PETSC_TRUE,0,PETSC_NULL,&nullsp);
177:           KSPSetNullSpace(pcis->ksp_N,nullsp);
178:           MatNullSpaceDestroy(nullsp);
179:         }
180:       } else {  /* fixed subdomain */
181:         if (damp_fixed) {
182:           PCFactorSetShiftNonzero(pc_ctx,fixed_factor);
183:         }
184:         if (remove_nullspace_fixed) {
185:           MatNullSpace nullsp;
186:           MatNullSpaceCreate(PETSC_COMM_SELF,PETSC_TRUE,0,PETSC_NULL,&nullsp);
187:           KSPSetNullSpace(pcis->ksp_N,nullsp);
188:           MatNullSpaceDestroy(nullsp);
189:         }
190:       }
191:     }
192:     /* the vectors in the following line are dummy arguments, just telling the KSP the vector size. Values are not used */
193:     KSPSetUp(pcis->ksp_N);
194:   }

196:   ISLocalToGlobalMappingGetInfo(((Mat_IS*)(pc->mat->data))->mapping,&(pcis->n_neigh),&(pcis->neigh),&(pcis->n_shared),&(pcis->shared));
197:   pcis->ISLocalToGlobalMappingGetInfoWasCalled = PETSC_TRUE;
198:   return(0);
199: }

201: /* -------------------------------------------------------------------------- */
202: /*
203:    PCISDestroy -
204: */
207: PetscErrorCode PETSCKSP_DLLEXPORT PCISDestroy(PC pc)
208: {
209:   PC_IS          *pcis = (PC_IS*)(pc->data);

213:   if (pcis->is_B_local)  {ISDestroy(pcis->is_B_local);}
214:   if (pcis->is_I_local)  {ISDestroy(pcis->is_I_local);}
215:   if (pcis->is_B_global) {ISDestroy(pcis->is_B_global);}
216:   if (pcis->is_I_global) {ISDestroy(pcis->is_I_global);}
217:   if (pcis->A_II)        {MatDestroy(pcis->A_II);}
218:   if (pcis->A_IB)        {MatDestroy(pcis->A_IB);}
219:   if (pcis->A_BI)        {MatDestroy(pcis->A_BI);}
220:   if (pcis->A_BB)        {MatDestroy(pcis->A_BB);}
221:   if (pcis->D)           {VecDestroy(pcis->D);}
222:   if (pcis->ksp_N)      {KSPDestroy(pcis->ksp_N);}
223:   if (pcis->ksp_D)      {KSPDestroy(pcis->ksp_D);}
224:   if (pcis->vec1_N)      {VecDestroy(pcis->vec1_N);}
225:   if (pcis->vec2_N)      {VecDestroy(pcis->vec2_N);}
226:   if (pcis->vec1_D)      {VecDestroy(pcis->vec1_D);}
227:   if (pcis->vec2_D)      {VecDestroy(pcis->vec2_D);}
228:   if (pcis->vec3_D)      {VecDestroy(pcis->vec3_D);}
229:   if (pcis->vec1_B)      {VecDestroy(pcis->vec1_B);}
230:   if (pcis->vec2_B)      {VecDestroy(pcis->vec2_B);}
231:   if (pcis->vec3_B)      {VecDestroy(pcis->vec3_B);}
232:   if (pcis->vec1_global) {VecDestroy(pcis->vec1_global);}
233:   if (pcis->global_to_D) {VecScatterDestroy(pcis->global_to_D);}
234:   if (pcis->N_to_B)      {VecScatterDestroy(pcis->N_to_B);}
235:   if (pcis->global_to_B) {VecScatterDestroy(pcis->global_to_B);}
236:   PetscFree(pcis->work_N);
237:   if (pcis->ISLocalToGlobalMappingGetInfoWasCalled) {
238:     ISLocalToGlobalMappingRestoreInfo((ISLocalToGlobalMapping)0,&(pcis->n_neigh),&(pcis->neigh),&(pcis->n_shared),&(pcis->shared));
239:   }
240:   return(0);
241: }

243: /* -------------------------------------------------------------------------- */
244: /*
245:    PCISCreate - 
246: */
249: PetscErrorCode PETSCKSP_DLLEXPORT PCISCreate(PC pc)
250: {
251:   PC_IS *pcis = (PC_IS*)(pc->data);

254:   pcis->is_B_local  = 0;
255:   pcis->is_I_local  = 0;
256:   pcis->is_B_global = 0;
257:   pcis->is_I_global = 0;
258:   pcis->A_II        = 0;
259:   pcis->A_IB        = 0;
260:   pcis->A_BI        = 0;
261:   pcis->A_BB        = 0;
262:   pcis->D           = 0;
263:   pcis->ksp_N      = 0;
264:   pcis->ksp_D      = 0;
265:   pcis->vec1_N      = 0;
266:   pcis->vec2_N      = 0;
267:   pcis->vec1_D      = 0;
268:   pcis->vec2_D      = 0;
269:   pcis->vec3_D      = 0;
270:   pcis->vec1_B      = 0;
271:   pcis->vec2_B      = 0;
272:   pcis->vec3_B      = 0;
273:   pcis->vec1_global = 0;
274:   pcis->work_N      = 0;
275:   pcis->global_to_D = 0;
276:   pcis->N_to_B      = 0;
277:   pcis->global_to_B = 0;
278:   pcis->ISLocalToGlobalMappingGetInfoWasCalled = PETSC_FALSE;
279:   return(0);
280: }

282: /* -------------------------------------------------------------------------- */
283: /*
284:    PCISApplySchur -

286:    Input parameters:
287: .  pc - preconditioner context
288: .  v - vector to which the Schur complement is to be applied (it is NOT modified inside this function, UNLESS vec2_B is null)

290:    Output parameters:
291: .  vec1_B - result of Schur complement applied to chunk
292: .  vec2_B - garbage (used as work space), or null (and v is used as workspace)
293: .  vec1_D - garbage (used as work space)
294: .  vec2_D - garbage (used as work space)

296: */
299: PetscErrorCode PETSCKSP_DLLEXPORT PCISApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
300: {
302:   PC_IS          *pcis = (PC_IS*)(pc->data);

305:   if (!vec2_B) { vec2_B = v; }

307:   MatMult(pcis->A_BB,v,vec1_B);
308:   MatMult(pcis->A_IB,v,vec1_D);
309:   KSPSolve(pcis->ksp_D,vec1_D,vec2_D);
310:   MatMult(pcis->A_BI,vec2_D,vec2_B);
311:   VecAXPY(vec1_B,-1.0,vec2_B);
312:   return(0);
313: }

315: /* -------------------------------------------------------------------------- */
316: /*
317:    PCISScatterArrayNToVecB - Scatters interface node values from a big array (of all local nodes, interior or interface,
318:    including ghosts) into an interface vector, when in SCATTER_FORWARD mode, or vice-versa, when in SCATTER_REVERSE
319:    mode.

321:    Input parameters:
322: .  pc - preconditioner context
323: .  array_N - [when in SCATTER_FORWARD mode] Array to be scattered into the vector
324: .  v_B - [when in SCATTER_REVERSE mode] Vector to be scattered into the array

326:    Output parameter:
327: .  array_N - [when in SCATTER_REVERSE mode] Array to receive the scattered vector
328: .  v_B - [when in SCATTER_FORWARD mode] Vector to receive the scattered array

330:    Notes:
331:    The entries in the array that do not correspond to interface nodes remain unaltered.
332: */
335: PetscErrorCode PETSCKSP_DLLEXPORT PCISScatterArrayNToVecB (PetscScalar *array_N, Vec v_B, InsertMode imode, ScatterMode smode, PC pc)
336: {
337:   PetscInt       i, *idex;
339:   PetscScalar    *array_B;
340:   PC_IS          *pcis = (PC_IS*)(pc->data);

343:   VecGetArray(v_B,&array_B);
344:   ISGetIndices(pcis->is_B_local,&idex);

346:   if (smode == SCATTER_FORWARD) {
347:     if (imode == INSERT_VALUES) {
348:       for (i=0; i<pcis->n_B; i++) { array_B[i]  = array_N[idex[i]]; }
349:     } else {  /* ADD_VALUES */
350:       for (i=0; i<pcis->n_B; i++) { array_B[i] += array_N[idex[i]]; }
351:     }
352:   } else {  /* SCATTER_REVERSE */
353:     if (imode == INSERT_VALUES) {
354:       for (i=0; i<pcis->n_B; i++) { array_N[idex[i]]  = array_B[i]; }
355:     } else {  /* ADD_VALUES */
356:       for (i=0; i<pcis->n_B; i++) { array_N[idex[i]] += array_B[i]; }
357:     }
358:   }
359:   ISRestoreIndices(pcis->is_B_local,&idex);
360:   VecRestoreArray(v_B,&array_B);
361:   return(0);
362: }

364: /* -------------------------------------------------------------------------- */
365: /*
366:    PCISApplyInvSchur - Solves the Neumann problem related to applying the inverse of the Schur complement.
367:    More precisely, solves the problem:
368:                                         [ A_II  A_IB ] [ . ]   [ 0 ]
369:                                         [            ] [   ] = [   ]
370:                                         [ A_BI  A_BB ] [ x ]   [ b ]

372:    Input parameters:
373: .  pc - preconditioner context
374: .  b - vector of local interface nodes (including ghosts)

376:    Output parameters:
377: .  x - vector of local interface nodes (including ghosts); returns the application of the inverse of the Schur
378:        complement to b
379: .  vec1_N - vector of local nodes (interior and interface, including ghosts); returns garbage (used as work space)
380: .  vec2_N - vector of local nodes (interior and interface, including ghosts); returns garbage (used as work space)

382: */
385: PetscErrorCode PETSCKSP_DLLEXPORT PCISApplyInvSchur (PC pc, Vec b, Vec x, Vec vec1_N, Vec vec2_N)
386: {
388:   PC_IS          *pcis = (PC_IS*)(pc->data);

391:   /*
392:     Neumann solvers. 
393:     Applying the inverse of the local Schur complement, i.e, solving a Neumann
394:     Problem with zero at the interior nodes of the RHS and extracting the interface
395:     part of the solution. inverse Schur complement is applied to b and the result
396:     is stored in x.
397:   */
398:   /* Setting the RHS vec1_N */
399:   VecSet(vec1_N,0.0);
400:   VecScatterBegin(b,vec1_N,INSERT_VALUES,SCATTER_REVERSE,pcis->N_to_B);
401:   VecScatterEnd  (b,vec1_N,INSERT_VALUES,SCATTER_REVERSE,pcis->N_to_B);
402:   /* Checking for consistency of the RHS */
403:   {
404:     PetscTruth flg;
405:     PetscOptionsHasName(PETSC_NULL,"-pc_is_check_consistency",&flg);
406:     if (flg) {
407:       PetscScalar average;
408:       VecSum(vec1_N,&average);
409:       average = average / ((PetscReal)pcis->n);
410:       if (pcis->pure_neumann) {
411:         PetscViewerASCIISynchronizedPrintf(PETSC_VIEWER_STDOUT_(pc->comm),"Subdomain %04d is floating. Average = % 1.14e\n",
412:                                              PetscGlobalRank,PetscAbsScalar(average));
413:       } else {
414:         PetscViewerASCIISynchronizedPrintf(PETSC_VIEWER_STDOUT_(pc->comm),"Subdomain %04d is fixed.    Average = % 1.14e\n",
415:                                              PetscGlobalRank,PetscAbsScalar(average));
416:       }
417:       PetscViewerFlush(PETSC_VIEWER_STDOUT_(pc->comm));
418:     }
419:   }
420:   /* Solving the system for vec2_N */
421:   KSPSolve(pcis->ksp_N,vec1_N,vec2_N);
422:   /* Extracting the local interface vector out of the solution */
423:   VecScatterBegin(vec2_N,x,INSERT_VALUES,SCATTER_FORWARD,pcis->N_to_B);
424:   VecScatterEnd  (vec2_N,x,INSERT_VALUES,SCATTER_FORWARD,pcis->N_to_B);
425:   return(0);
426: }