Actual source code: is.c

  1: /*$Id: is.c,v 1.9 2001/08/07 03:03:41 balay Exp $*/
 2:  #include src/sles/pc/impls/is/is.h

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

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

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

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

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

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

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

112:   /* Creating the scatter contexts */
113:   VecScatterCreate(pc->vec,pcis->is_I_global,pcis->vec1_D,(IS)0,&pcis->global_to_D);
114:   VecScatterCreate(pcis->vec1_N,pcis->is_B_local,pcis->vec1_B,(IS)0,&pcis->N_to_B);
115:   VecScatterCreate(pc->vec,pcis->is_B_global,pcis->vec1_B,(IS)0,&pcis->global_to_B);

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

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

125:   /*
126:     Creating the SLES contexts for the local Dirichlet and Neumann problems.
127:   */
128:   {
129:     PC  pc_ctx;
130:     KSP ksp_ctx;
131:     /* Dirichlet */
132:     SLESCreate(PETSC_COMM_SELF,&pcis->sles_D);
133:     SLESSetOperators(pcis->sles_D,pcis->A_II,pcis->A_II,SAME_PRECONDITIONER);
134:     SLESSetOptionsPrefix(pcis->sles_D,"localD_");
135:     SLESGetKSP(pcis->sles_D,&ksp_ctx);
136:     SLESGetPC(pcis->sles_D,&pc_ctx);
137:     PCSetType(pc_ctx,PCLU);
138:     KSPSetType(ksp_ctx,KSPPREONLY);
139:     SLESSetFromOptions(pcis->sles_D);
140:     /* the vectors in the following line are dummy arguments, just telling the SLES the vector size. Values are not used */
141:     SLESSetUp(pcis->sles_D,pcis->vec1_D,pcis->vec2_D);
142:     /* Neumann */
143:     SLESCreate(PETSC_COMM_SELF,&pcis->sles_N);
144:     SLESSetOperators(pcis->sles_N,matis->A,matis->A,SAME_PRECONDITIONER);
145:     SLESSetOptionsPrefix(pcis->sles_N,"localN_");
146:     SLESGetKSP(pcis->sles_N,&ksp_ctx);
147:     SLESGetPC(pcis->sles_N,&pc_ctx);
148:     PCSetType(pc_ctx,PCLU);
149:     KSPSetType(ksp_ctx,KSPPREONLY);
150:     SLESSetFromOptions(pcis->sles_N);
151:     {
152:       PetscTruth damp_fixed,
153:                  remove_nullspace_fixed,
154:                  set_damping_factor_floating,
155:                  not_damp_floating,
156:                  not_remove_nullspace_floating;
157:       PetscReal  fixed_factor,
158:                  floating_factor;

160:       PetscOptionsGetReal(pc_ctx->prefix,"-pc_is_damp_fixed",&fixed_factor,&damp_fixed);
161:       if (!damp_fixed) { fixed_factor = 0.0; }
162:       PetscOptionsHasName(pc_ctx->prefix,"-pc_is_damp_fixed",&damp_fixed);

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

166:       PetscOptionsGetReal(pc_ctx->prefix,"-pc_is_set_damping_factor_floating",
167:                               &floating_factor,&set_damping_factor_floating);
168:       if (!set_damping_factor_floating) { floating_factor = 0.0; }
169:       PetscOptionsHasName(pc_ctx->prefix,"-pc_is_set_damping_factor_floating",&set_damping_factor_floating);
170:       if (!set_damping_factor_floating) { floating_factor = 1.e-12; }

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

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

176:       if (pcis->pure_neumann) {  /* floating subdomain */
177:         if (!(not_damp_floating)) {
178:           PCLUSetDamping (pc_ctx,floating_factor);
179:           PCILUSetDamping(pc_ctx,floating_factor);
180:         }
181:         if (!(not_remove_nullspace_floating)){
182:           MatNullSpace nullsp;
183:           MatNullSpaceCreate(PETSC_COMM_SELF,1,0,PETSC_NULL,&nullsp);
184:           PCNullSpaceAttach(pc_ctx,nullsp);
185:           MatNullSpaceDestroy(nullsp);
186:         }
187:       } else {  /* fixed subdomain */
188:         if (damp_fixed) {
189:           PCLUSetDamping (pc_ctx,fixed_factor);
190:           PCILUSetDamping(pc_ctx,fixed_factor);
191:         }
192:         if (remove_nullspace_fixed) {
193:           MatNullSpace nullsp;
194:           MatNullSpaceCreate(PETSC_COMM_SELF,1,0,PETSC_NULL,&nullsp);
195:           PCNullSpaceAttach(pc_ctx,nullsp);
196:           MatNullSpaceDestroy(nullsp);
197:         }
198:       }
199:     }
200:     /* the vectors in the following line are dummy arguments, just telling the SLES the vector size. Values are not used */
201:     SLESSetUp(pcis->sles_N,pcis->vec1_N,pcis->vec2_N);
202:   }

204:   ISLocalToGlobalMappingGetInfo(((Mat_IS*)(pc->mat->data))->mapping,&(pcis->n_neigh),&(pcis->neigh),
205:                                        &(pcis->n_shared),&(pcis->shared));
206:   pcis->ISLocalToGlobalMappingGetInfoWasCalled = PETSC_TRUE;

208:   return(0);
209: }

211: /* -------------------------------------------------------------------------- */
212: /*
213:    PCISDestroy -
214: */
217: int PCISDestroy(PC pc)
218: {
219:   PC_IS *pcis = (PC_IS*)(pc->data);
220:   int   ierr;


224:   if (pcis->is_B_local)  {ISDestroy(pcis->is_B_local);}
225:   if (pcis->is_I_local)  {ISDestroy(pcis->is_I_local);}
226:   if (pcis->is_B_global) {ISDestroy(pcis->is_B_global);}
227:   if (pcis->is_I_global) {ISDestroy(pcis->is_I_global);}
228:   if (pcis->A_II)        {MatDestroy(pcis->A_II);}
229:   if (pcis->A_IB)        {MatDestroy(pcis->A_IB);}
230:   if (pcis->A_BI)        {MatDestroy(pcis->A_BI);}
231:   if (pcis->A_BB)        {MatDestroy(pcis->A_BB);}
232:   if (pcis->D)           {VecDestroy(pcis->D);}
233:   if (pcis->sles_N)      {SLESDestroy(pcis->sles_N);}
234:   if (pcis->sles_D)      {SLESDestroy(pcis->sles_D);}
235:   if (pcis->vec1_N)      {VecDestroy(pcis->vec1_N);}
236:   if (pcis->vec2_N)      {VecDestroy(pcis->vec2_N);}
237:   if (pcis->vec1_D)      {VecDestroy(pcis->vec1_D);}
238:   if (pcis->vec2_D)      {VecDestroy(pcis->vec2_D);}
239:   if (pcis->vec3_D)      {VecDestroy(pcis->vec3_D);}
240:   if (pcis->vec1_B)      {VecDestroy(pcis->vec1_B);}
241:   if (pcis->vec2_B)      {VecDestroy(pcis->vec2_B);}
242:   if (pcis->vec3_B)      {VecDestroy(pcis->vec3_B);}
243:   if (pcis->vec1_global) {VecDestroy(pcis->vec1_global);}
244:   if (pcis->work_N)      {PetscFree(pcis->work_N);}
245:   if (pcis->global_to_D) {VecScatterDestroy(pcis->global_to_D);}
246:   if (pcis->N_to_B)      {VecScatterDestroy(pcis->N_to_B);}
247:   if (pcis->global_to_B) {VecScatterDestroy(pcis->global_to_B);}
248:   if (pcis->ISLocalToGlobalMappingGetInfoWasCalled) {
249:     ISLocalToGlobalMappingRestoreInfo((ISLocalToGlobalMapping)0,&(pcis->n_neigh),&(pcis->neigh),&(pcis->n_shared),&(pcis->shared));
250:   }

252:   return(0);
253: }

255: /* -------------------------------------------------------------------------- */
256: /*
257:    PCISCreate - 
258: */
261: int PCISCreate(PC pc)
262: {
263:   PC_IS *pcis = (PC_IS*)(pc->data);


267:   pcis->is_B_local  = 0;
268:   pcis->is_I_local  = 0;
269:   pcis->is_B_global = 0;
270:   pcis->is_I_global = 0;
271:   pcis->A_II        = 0;
272:   pcis->A_IB        = 0;
273:   pcis->A_BI        = 0;
274:   pcis->A_BB        = 0;
275:   pcis->D           = 0;
276:   pcis->sles_N      = 0;
277:   pcis->sles_D      = 0;
278:   pcis->vec1_N      = 0;
279:   pcis->vec2_N      = 0;
280:   pcis->vec1_D      = 0;
281:   pcis->vec2_D      = 0;
282:   pcis->vec3_D      = 0;
283:   pcis->vec1_B      = 0;
284:   pcis->vec2_B      = 0;
285:   pcis->vec3_B      = 0;
286:   pcis->vec1_global = 0;
287:   pcis->work_N      = 0;
288:   pcis->global_to_D = 0;
289:   pcis->N_to_B      = 0;
290:   pcis->global_to_B = 0;
291:   pcis->ISLocalToGlobalMappingGetInfoWasCalled = PETSC_FALSE;

293:   return(0);
294: }

296: /* -------------------------------------------------------------------------- */
297: /*
298:    PCISApplySchur -

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

304:    Output parameters:
305: .  vec1_B - result of Schur complement applied to chunk
306: .  vec2_B - garbage (used as work space), or null (and v is used as workspace)
307: .  vec1_D - garbage (used as work space)
308: .  vec2_D - garbage (used as work space)

310: */
313: int PCISApplySchur(PC pc, Vec v, Vec vec1_B, Vec vec2_B, Vec vec1_D, Vec vec2_D)
314: {
315:   int    ierr, its;
316:   PetscScalar m_one = -1.0;
317:   PC_IS  *pcis = (PC_IS*)(pc->data);


321:   if (vec2_B == (Vec)0) { vec2_B = v; }

323:   MatMult(pcis->A_BB,v,vec1_B);
324:   MatMult(pcis->A_IB,v,vec1_D);
325:   SLESSolve(pcis->sles_D,vec1_D,vec2_D,&its);
326:   MatMult(pcis->A_BI,vec2_D,vec2_B);
327:   VecAXPY(&m_one,vec2_B,vec1_B);

329:   return(0);
330: }

332: /* -------------------------------------------------------------------------- */
333: /*
334:    PCISScatterArrayNToVecB - Scatters interface node values from a big array (of all local nodes, interior or interface,
335:    including ghosts) into an interface vector, when in SCATTER_FORWARD mode, or vice-versa, when in SCATTER_REVERSE
336:    mode.

338:    Input parameters:
339: .  pc - preconditioner context
340: .  array_N - [when in SCATTER_FORWARD mode] Array to be scattered into the vector
341: .  v_B - [when in SCATTER_REVERSE mode] Vector to be scattered into the array

343:    Output parameter:
344: .  array_N - [when in SCATTER_REVERSE mode] Array to receive the scattered vector
345: .  v_B - [when in SCATTER_FORWARD mode] Vector to receive the scattered array

347:    Notes:
348:    The entries in the array that do not correspond to interface nodes remain unaltered.
349: */
352: int PCISScatterArrayNToVecB (PetscScalar *array_N, Vec v_B, InsertMode imode, ScatterMode smode, PC pc)
353: {
354:   int         i, ierr, *idex;
355:   PetscScalar *array_B;
356:   PC_IS       *pcis = (PC_IS*)(pc->data);


360:   VecGetArray(v_B,&array_B);
361:   ISGetIndices(pcis->is_B_local,&idex);

363:   if (smode == SCATTER_FORWARD) {
364:     if (imode == INSERT_VALUES) {
365:       for (i=0; i<pcis->n_B; i++) { array_B[i]  = array_N[idex[i]]; }
366:     } else {  /* ADD_VALUES */
367:       for (i=0; i<pcis->n_B; i++) { array_B[i] += array_N[idex[i]]; }
368:     }
369:   } else {  /* SCATTER_REVERSE */
370:     if (imode == INSERT_VALUES) {
371:       for (i=0; i<pcis->n_B; i++) { array_N[idex[i]]  = array_B[i]; }
372:     } else {  /* ADD_VALUES */
373:       for (i=0; i<pcis->n_B; i++) { array_N[idex[i]] += array_B[i]; }
374:     }
375:   }

377:   ISRestoreIndices(pcis->is_B_local,&idex);
378:   VecRestoreArray(v_B,&array_B);

380:   return(0);
381: }

383: /* -------------------------------------------------------------------------- */
384: /*
385:    PCISApplyInvSchur - Solves the Neumann problem related to applying the inverse of the Schur complement.
386:    More precisely, solves the problem:
387:                                         [ A_II  A_IB ] [ . ]   [ 0 ]
388:                                         [            ] [   ] = [   ]
389:                                         [ A_BI  A_BB ] [ x ]   [ b ]

391:    Input parameters:
392: .  pc - preconditioner context
393: .  b - vector of local interface nodes (including ghosts)

395:    Output parameters:
396: .  x - vector of local interface nodes (including ghosts); returns the application of the inverse of the Schur
397:        complement to b
398: .  vec1_N - vector of local nodes (interior and interface, including ghosts); returns garbage (used as work space)
399: .  vec2_N - vector of local nodes (interior and interface, including ghosts); returns garbage (used as work space)

401: */
404: int PCISApplyInvSchur (PC pc, Vec b, Vec x, Vec vec1_N, Vec vec2_N)
405: {
406:   int    ierr, its;
407:   PC_IS  *pcis = (PC_IS*)(pc->data);
408:   PetscScalar zero  = 0.0;


412:   /*
413:     Neumann solvers. 
414:     Applying the inverse of the local Schur complement, i.e, solving a Neumann
415:     Problem with zero at the interior nodes of the RHS and extracting the interface
416:     part of the solution. inverse Schur complement is applied to b and the result
417:     is stored in x.
418:   */
419:   /* Setting the RHS vec1_N */
420:   VecSet(&zero,vec1_N);
421:   VecScatterBegin(b,vec1_N,INSERT_VALUES,SCATTER_REVERSE,pcis->N_to_B);
422:   VecScatterEnd  (b,vec1_N,INSERT_VALUES,SCATTER_REVERSE,pcis->N_to_B);
423:   /* Checking for consistency of the RHS */
424:   {
425:     PetscTruth flg;
426:     PetscOptionsHasName(PETSC_NULL,"-check_consistency",&flg);
427:     if (flg) {
428:       PetscScalar average;
429:       VecSum(vec1_N,&average);
430:       average = average / ((PetscReal)pcis->n);
431:       if (pcis->pure_neumann) {
432:         PetscViewerASCIISynchronizedPrintf(PETSC_VIEWER_STDOUT_(pc->comm),"Subdomain %04d is floating. Average = % 1.14e\n",
433:                                              PetscGlobalRank,PetscAbsScalar(average));
434:       } else {
435:         PetscViewerASCIISynchronizedPrintf(PETSC_VIEWER_STDOUT_(pc->comm),"Subdomain %04d is fixed.    Average = % 1.14e\n",
436:                                              PetscGlobalRank,PetscAbsScalar(average));
437:       }
438:       PetscViewerFlush(PETSC_VIEWER_STDOUT_(pc->comm));
439:     }
440:   }
441:   /* Solving the system for vec2_N */
442:   SLESSolve(pcis->sles_N,vec1_N,vec2_N,&its);
443:   /* Extracting the local interface vector out of the solution */
444:   VecScatterBegin(vec2_N,x,INSERT_VALUES,SCATTER_FORWARD,pcis->N_to_B);
445:   VecScatterEnd  (vec2_N,x,INSERT_VALUES,SCATTER_FORWARD,pcis->N_to_B);

447:   return(0);
448: }