xref: /petsc/src/mat/interface/matnull.c (revision 016831ca33bf2430c76d3a9e4f4cb588b7ab0b91)
1 
2 /*
3     Routines to project vectors out of null spaces.
4 */
5 
6 #include <petsc/private/matimpl.h>      /*I "petscmat.h" I*/
7 
8 PetscClassId MAT_NULLSPACE_CLASSID;
9 
10 /*@C
11    MatNullSpaceSetFunction - set a function that removes a null space from a vector
12    out of null spaces.
13 
14    Logically Collective on MatNullSpace
15 
16    Input Parameters:
17 +  sp - the null space object
18 .  rem - the function that removes the null space
19 -  ctx - context for the remove function
20 
21    Level: advanced
22 
23 .keywords: PC, null space, create
24 
25 .seealso: MatNullSpaceDestroy(), MatNullSpaceRemove(), MatSetNullSpace(), MatNullSpace, MatNullSpaceCreate()
26 @*/
27 PetscErrorCode  MatNullSpaceSetFunction(MatNullSpace sp, PetscErrorCode (*rem)(MatNullSpace,Vec,void*),void *ctx)
28 {
29   PetscFunctionBegin;
30   PetscValidHeaderSpecific(sp,MAT_NULLSPACE_CLASSID,1);
31   sp->remove = rem;
32   sp->rmctx  = ctx;
33   PetscFunctionReturn(0);
34 }
35 
36 /*@C
37    MatNullSpaceGetVecs - get vectors defining the null space
38 
39    Not Collective
40 
41    Input Arguments:
42 .  sp - null space object
43 
44    Output Arguments:
45 +  has_cnst - PETSC_TRUE if the null space contains the constant vector, otherwise PETSC_FALSE
46 .  n - number of vectors (excluding constant vector) in null space
47 -  vecs - orthonormal vectors that span the null space (excluding the constant vector)
48 
49    Level: developer
50 
51    Notes:
52       These vectors and the array are owned by the MatNullSpace and should not be destroyed or freeded by the caller
53 
54 .seealso: MatNullSpaceCreate(), MatGetNullSpace(), MatGetNearNullSpace()
55 @*/
56 PetscErrorCode MatNullSpaceGetVecs(MatNullSpace sp,PetscBool *has_const,PetscInt *n,const Vec **vecs)
57 {
58 
59   PetscFunctionBegin;
60   PetscValidHeaderSpecific(sp,MAT_NULLSPACE_CLASSID,1);
61   if (has_const) *has_const = sp->has_cnst;
62   if (n) *n = sp->n;
63   if (vecs) *vecs = sp->vecs;
64   PetscFunctionReturn(0);
65 }
66 
67 /*@
68    MatNullSpaceCreateRigidBody - create rigid body modes from coordinates
69 
70    Collective on Vec
71 
72    Input Argument:
73 .  coords - block of coordinates of each node, must have block size set
74 
75    Output Argument:
76 .  sp - the null space
77 
78    Level: advanced
79 
80 .seealso: MatNullSpaceCreate()
81 @*/
82 PetscErrorCode MatNullSpaceCreateRigidBody(Vec coords,MatNullSpace *sp)
83 {
84   PetscErrorCode    ierr;
85   const PetscScalar *x;
86   PetscScalar       *v[6],dots[5];
87   Vec               vec[6];
88   PetscInt          n,N,dim,nmodes,i,j;
89   PetscReal         sN;
90 
91   PetscFunctionBegin;
92   ierr = VecGetBlockSize(coords,&dim);CHKERRQ(ierr);
93   ierr = VecGetLocalSize(coords,&n);CHKERRQ(ierr);
94   ierr = VecGetSize(coords,&N);CHKERRQ(ierr);
95   n   /= dim;
96   N   /= dim;
97   sN = 1./PetscSqrtReal((PetscReal)N);
98   switch (dim) {
99   case 1:
100     ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coords),PETSC_TRUE,0,NULL,sp);CHKERRQ(ierr);
101     break;
102   case 2:
103   case 3:
104     nmodes = (dim == 2) ? 3 : 6;
105     ierr   = VecCreate(PetscObjectComm((PetscObject)coords),&vec[0]);CHKERRQ(ierr);
106     ierr   = VecSetSizes(vec[0],dim*n,dim*N);CHKERRQ(ierr);
107     ierr   = VecSetBlockSize(vec[0],dim);CHKERRQ(ierr);
108     ierr   = VecSetUp(vec[0]);CHKERRQ(ierr);
109     for (i=1; i<nmodes; i++) {ierr = VecDuplicate(vec[0],&vec[i]);CHKERRQ(ierr);}
110     for (i=0; i<nmodes; i++) {ierr = VecGetArray(vec[i],&v[i]);CHKERRQ(ierr);}
111     ierr = VecGetArrayRead(coords,&x);CHKERRQ(ierr);
112     for (i=0; i<n; i++) {
113       if (dim == 2) {
114         v[0][i*2+0] = sN;
115         v[0][i*2+1] = 0.;
116         v[1][i*2+0] = 0.;
117         v[1][i*2+1] = sN;
118         /* Rotations */
119         v[2][i*2+0] = -x[i*2+1];
120         v[2][i*2+1] = x[i*2+0];
121       } else {
122         v[0][i*3+0] = sN;
123         v[0][i*3+1] = 0.;
124         v[0][i*3+2] = 0.;
125         v[1][i*3+0] = 0.;
126         v[1][i*3+1] = sN;
127         v[1][i*3+2] = 0.;
128         v[2][i*3+0] = 0.;
129         v[2][i*3+1] = 0.;
130         v[2][i*3+2] = sN;
131 
132         v[3][i*3+0] = x[i*3+1];
133         v[3][i*3+1] = -x[i*3+0];
134         v[3][i*3+2] = 0.;
135         v[4][i*3+0] = 0.;
136         v[4][i*3+1] = -x[i*3+2];
137         v[4][i*3+2] = x[i*3+1];
138         v[5][i*3+0] = x[i*3+2];
139         v[5][i*3+1] = 0.;
140         v[5][i*3+2] = -x[i*3+0];
141       }
142     }
143     for (i=0; i<nmodes; i++) {ierr = VecRestoreArray(vec[i],&v[i]);CHKERRQ(ierr);}
144     ierr = VecRestoreArrayRead(coords,&x);CHKERRQ(ierr);
145     for (i=dim; i<nmodes; i++) {
146       /* Orthonormalize vec[i] against vec[0:i-1] */
147       ierr = VecMDot(vec[i],i,vec,dots);CHKERRQ(ierr);
148       for (j=0; j<i; j++) dots[j] *= -1.;
149       ierr = VecMAXPY(vec[i],i,dots,vec);CHKERRQ(ierr);
150       ierr = VecNormalize(vec[i],NULL);CHKERRQ(ierr);
151     }
152     ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coords),PETSC_FALSE,nmodes,vec,sp);CHKERRQ(ierr);
153     for (i=0; i<nmodes; i++) {ierr = VecDestroy(&vec[i]);CHKERRQ(ierr);}
154   }
155   PetscFunctionReturn(0);
156 }
157 
158 /*@C
159    MatNullSpaceView - Visualizes a null space object.
160 
161    Collective on MatNullSpace
162 
163    Input Parameters:
164 +  matnull - the null space
165 -  viewer - visualization context
166 
167    Level: advanced
168 
169    Fortran Note:
170    This routine is not supported in Fortran.
171 
172 .seealso: MatNullSpaceCreate(), PetscViewerASCIIOpen()
173 @*/
174 PetscErrorCode MatNullSpaceView(MatNullSpace sp,PetscViewer viewer)
175 {
176   PetscErrorCode ierr;
177   PetscBool      iascii;
178 
179   PetscFunctionBegin;
180   PetscValidHeaderSpecific(sp,MAT_NULLSPACE_CLASSID,1);
181   if (!viewer) {
182     ierr = PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject)sp),&viewer);CHKERRQ(ierr);
183   }
184   PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,2);
185   PetscCheckSameComm(sp,1,viewer,2);
186 
187   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr);
188   if (iascii) {
189     PetscViewerFormat format;
190     PetscInt          i;
191     ierr = PetscViewerGetFormat(viewer,&format);CHKERRQ(ierr);
192     ierr = PetscObjectPrintClassNamePrefixType((PetscObject)sp,viewer);CHKERRQ(ierr);
193     ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
194     ierr = PetscViewerASCIIPrintf(viewer,"Contains %D vector%s%s\n",sp->n,sp->n==1 ? "" : "s",sp->has_cnst ? " and the constant" : "");CHKERRQ(ierr);
195     if (sp->remove) {ierr = PetscViewerASCIIPrintf(viewer,"Has user-provided removal function\n");CHKERRQ(ierr);}
196     if (!(format == PETSC_VIEWER_ASCII_INFO || format == PETSC_VIEWER_ASCII_INFO_DETAIL)) {
197       for (i=0; i<sp->n; i++) {
198         ierr = VecView(sp->vecs[i],viewer);CHKERRQ(ierr);
199       }
200     }
201     ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
202   }
203   PetscFunctionReturn(0);
204 }
205 
206 /*@C
207    MatNullSpaceCreate - Creates a data structure used to project vectors
208    out of null spaces.
209 
210    Collective on MPI_Comm
211 
212    Input Parameters:
213 +  comm - the MPI communicator associated with the object
214 .  has_cnst - PETSC_TRUE if the null space contains the constant vector; otherwise PETSC_FALSE
215 .  n - number of vectors (excluding constant vector) in null space
216 -  vecs - the vectors that span the null space (excluding the constant vector);
217           these vectors must be orthonormal. These vectors are NOT copied, so do not change them
218           after this call. You should free the array that you pass in and destroy the vectors (this will reduce the reference count
219           for them by one).
220 
221    Output Parameter:
222 .  SP - the null space context
223 
224    Level: advanced
225 
226    Notes: See MatNullSpaceSetFunction() as an alternative way of providing the null space information instead of setting vecs.
227 
228       If has_cnst is PETSC_TRUE you do not need to pass a constant vector in as a fourth argument to this routine, nor do you
229        need to pass in a function that eliminates the constant function into MatNullSpaceSetFunction().
230 
231   Users manual sections:
232 .   sec_singular
233 
234 .keywords: PC, null space, create
235 
236 .seealso: MatNullSpaceDestroy(), MatNullSpaceRemove(), MatSetNullSpace(), MatNullSpace, MatNullSpaceSetFunction()
237 @*/
238 PetscErrorCode  MatNullSpaceCreate(MPI_Comm comm,PetscBool has_cnst,PetscInt n,const Vec vecs[],MatNullSpace *SP)
239 {
240   MatNullSpace   sp;
241   PetscErrorCode ierr;
242   PetscInt       i;
243 
244   PetscFunctionBegin;
245   if (n < 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Number of vectors (given %D) cannot be negative",n);
246   if (n) PetscValidPointer(vecs,4);
247   for (i=0; i<n; i++) PetscValidHeaderSpecific(vecs[i],VEC_CLASSID,4);
248   PetscValidPointer(SP,5);
249   if (n) {
250     for (i=0; i<n; i++) {
251       /* prevent the user from changes values in the vector */
252       ierr = VecLockPush(vecs[i]);CHKERRQ(ierr);
253     }
254   }
255 #if defined(PETSC_USE_DEBUG)
256   if (n) {
257     PetscScalar *dots;
258     for (i=0; i<n; i++) {
259       PetscReal norm;
260       ierr = VecNorm(vecs[i],NORM_2,&norm);CHKERRQ(ierr);
261       if (PetscAbsReal(norm - 1) > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PetscObjectComm((PetscObject)vecs[i]),PETSC_ERR_ARG_WRONG,"Vector %D must have 2-norm of 1.0, it is %g",i,(double)norm);
262     }
263     if (has_cnst) {
264       for (i=0; i<n; i++) {
265         PetscScalar sum;
266         ierr = VecSum(vecs[i],&sum);CHKERRQ(ierr);
267         if (PetscAbsScalar(sum) > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PetscObjectComm((PetscObject)vecs[i]),PETSC_ERR_ARG_WRONG,"Vector %D must be orthogonal to constant vector, inner product is %g",i,(double)PetscAbsScalar(sum));
268       }
269     }
270     ierr = PetscMalloc1(n-1,&dots);CHKERRQ(ierr);
271     for (i=0; i<n-1; i++) {
272       PetscInt j;
273       ierr = VecMDot(vecs[i],n-i-1,vecs+i+1,dots);CHKERRQ(ierr);
274       for (j=0;j<n-i-1;j++) {
275         if (PetscAbsScalar(dots[j]) > PETSC_SQRT_MACHINE_EPSILON) SETERRQ3(PetscObjectComm((PetscObject)vecs[i]),PETSC_ERR_ARG_WRONG,"Vector %D must be orthogonal to vector %D, inner product is %g",i,i+j+1,(double)PetscAbsScalar(dots[j]));
276       }
277     }
278     PetscFree(dots);CHKERRQ(ierr);
279   }
280 #endif
281 
282   *SP = NULL;
283   ierr = MatInitializePackage();CHKERRQ(ierr);
284 
285   ierr = PetscHeaderCreate(sp,MAT_NULLSPACE_CLASSID,"MatNullSpace","Null space","Mat",comm,MatNullSpaceDestroy,MatNullSpaceView);CHKERRQ(ierr);
286 
287   sp->has_cnst = has_cnst;
288   sp->n        = n;
289   sp->vecs     = 0;
290   sp->alpha    = 0;
291   sp->remove   = 0;
292   sp->rmctx    = 0;
293 
294   if (n) {
295     ierr = PetscMalloc1(n,&sp->vecs);CHKERRQ(ierr);
296     ierr = PetscMalloc1(n,&sp->alpha);CHKERRQ(ierr);
297     ierr = PetscLogObjectMemory((PetscObject)sp,n*(sizeof(Vec)+sizeof(PetscScalar)));CHKERRQ(ierr);
298     for (i=0; i<n; i++) {
299       ierr        = PetscObjectReference((PetscObject)vecs[i]);CHKERRQ(ierr);
300       sp->vecs[i] = vecs[i];
301     }
302   }
303 
304   *SP = sp;
305   PetscFunctionReturn(0);
306 }
307 
308 /*@
309    MatNullSpaceDestroy - Destroys a data structure used to project vectors
310    out of null spaces.
311 
312    Collective on MatNullSpace
313 
314    Input Parameter:
315 .  sp - the null space context to be destroyed
316 
317    Level: advanced
318 
319 .keywords: PC, null space, destroy
320 
321 .seealso: MatNullSpaceCreate(), MatNullSpaceRemove(), MatNullSpaceSetFunction()
322 @*/
323 PetscErrorCode  MatNullSpaceDestroy(MatNullSpace *sp)
324 {
325   PetscErrorCode ierr;
326   PetscInt       i;
327 
328   PetscFunctionBegin;
329   if (!*sp) PetscFunctionReturn(0);
330   PetscValidHeaderSpecific((*sp),MAT_NULLSPACE_CLASSID,1);
331   if (--((PetscObject)(*sp))->refct > 0) {*sp = 0; PetscFunctionReturn(0);}
332 
333   for (i=0; i < (*sp)->n; i++) {
334     ierr = VecLockPop((*sp)->vecs[i]);CHKERRQ(ierr);
335   }
336 
337   ierr = VecDestroyVecs((*sp)->n,&(*sp)->vecs);CHKERRQ(ierr);
338   ierr = PetscFree((*sp)->alpha);CHKERRQ(ierr);
339   ierr = PetscHeaderDestroy(sp);CHKERRQ(ierr);
340   PetscFunctionReturn(0);
341 }
342 
343 /*@C
344    MatNullSpaceRemove - Removes all the components of a null space from a vector.
345 
346    Collective on MatNullSpace
347 
348    Input Parameters:
349 +  sp - the null space context (if this is NULL then no null space is removed)
350 -  vec - the vector from which the null space is to be removed
351 
352    Level: advanced
353 
354 .keywords: PC, null space, remove
355 
356 .seealso: MatNullSpaceCreate(), MatNullSpaceDestroy(), MatNullSpaceSetFunction()
357 @*/
358 PetscErrorCode  MatNullSpaceRemove(MatNullSpace sp,Vec vec)
359 {
360   PetscScalar    sum;
361   PetscInt       i,N;
362   PetscErrorCode ierr;
363 
364   PetscFunctionBegin;
365   if (!sp) PetscFunctionReturn(0);
366   PetscValidHeaderSpecific(sp,MAT_NULLSPACE_CLASSID,1);
367   PetscValidHeaderSpecific(vec,VEC_CLASSID,2);
368 
369   if (sp->has_cnst) {
370     ierr = VecGetSize(vec,&N);CHKERRQ(ierr);
371     if (N > 0) {
372       ierr = VecSum(vec,&sum);CHKERRQ(ierr);
373       sum  = sum/((PetscScalar)(-1.0*N));
374       ierr = VecShift(vec,sum);CHKERRQ(ierr);
375     }
376   }
377 
378   if (sp->n) {
379     ierr = VecMDot(vec,sp->n,sp->vecs,sp->alpha);CHKERRQ(ierr);
380     for (i=0; i<sp->n; i++) sp->alpha[i] = -sp->alpha[i];
381     ierr = VecMAXPY(vec,sp->n,sp->alpha,sp->vecs);CHKERRQ(ierr);
382   }
383 
384   if (sp->remove) {
385     ierr = (*sp->remove)(sp,vec,sp->rmctx);CHKERRQ(ierr);
386   }
387   PetscFunctionReturn(0);
388 }
389 
390 /*@
391    MatNullSpaceTest  - Tests if the claimed null space is really a
392      null space of a matrix
393 
394    Collective on MatNullSpace
395 
396    Input Parameters:
397 +  sp - the null space context
398 -  mat - the matrix
399 
400    Output Parameters:
401 .  isNull - PETSC_TRUE if the nullspace is valid for this matrix
402 
403    Level: advanced
404 
405 .keywords: PC, null space, remove
406 
407 .seealso: MatNullSpaceCreate(), MatNullSpaceDestroy(), MatNullSpaceSetFunction()
408 @*/
409 PetscErrorCode  MatNullSpaceTest(MatNullSpace sp,Mat mat,PetscBool  *isNull)
410 {
411   PetscScalar    sum;
412   PetscReal      nrm,tol = 10. * PETSC_SQRT_MACHINE_EPSILON;
413   PetscInt       j,n,N;
414   PetscErrorCode ierr;
415   Vec            l,r;
416   PetscBool      flg1 = PETSC_FALSE,flg2 = PETSC_FALSE,consistent = PETSC_TRUE;
417   PetscViewer    viewer;
418 
419   PetscFunctionBegin;
420   PetscValidHeaderSpecific(sp,MAT_NULLSPACE_CLASSID,1);
421   PetscValidHeaderSpecific(mat,MAT_CLASSID,2);
422   n    = sp->n;
423   ierr = PetscOptionsGetBool(((PetscObject)sp)->options,NULL,"-mat_null_space_test_view",&flg1,NULL);CHKERRQ(ierr);
424   ierr = PetscOptionsGetBool(((PetscObject)sp)->options,NULL,"-mat_null_space_test_view_draw",&flg2,NULL);CHKERRQ(ierr);
425 
426   if (n) {
427     ierr = VecDuplicate(sp->vecs[0],&l);CHKERRQ(ierr);
428   } else {
429     ierr = MatCreateVecs(mat,&l,NULL);CHKERRQ(ierr);
430   }
431 
432   ierr = PetscViewerASCIIGetStdout(PetscObjectComm((PetscObject)sp),&viewer);CHKERRQ(ierr);
433   if (sp->has_cnst) {
434     ierr = VecDuplicate(l,&r);CHKERRQ(ierr);
435     ierr = VecGetSize(l,&N);CHKERRQ(ierr);
436     sum  = 1.0/N;
437     ierr = VecSet(l,sum);CHKERRQ(ierr);
438     ierr = MatMult(mat,l,r);CHKERRQ(ierr);
439     ierr = VecNorm(r,NORM_2,&nrm);CHKERRQ(ierr);
440     if (nrm >= tol) consistent = PETSC_FALSE;
441     if (flg1) {
442       if (consistent) {
443         ierr = PetscPrintf(PetscObjectComm((PetscObject)sp),"Constants are likely null vector");CHKERRQ(ierr);
444       } else {
445         ierr = PetscPrintf(PetscObjectComm((PetscObject)sp),"Constants are unlikely null vector ");CHKERRQ(ierr);
446       }
447       ierr = PetscPrintf(PetscObjectComm((PetscObject)sp),"|| A * 1/N || = %g\n",(double)nrm);CHKERRQ(ierr);
448     }
449     if (!consistent && flg1) {ierr = VecView(r,viewer);CHKERRQ(ierr);}
450     if (!consistent && flg2) {ierr = VecView(r,viewer);CHKERRQ(ierr);}
451     ierr = VecDestroy(&r);CHKERRQ(ierr);
452   }
453 
454   for (j=0; j<n; j++) {
455     ierr = (*mat->ops->mult)(mat,sp->vecs[j],l);CHKERRQ(ierr);
456     ierr = VecNorm(l,NORM_2,&nrm);CHKERRQ(ierr);
457     if (nrm >= tol) consistent = PETSC_FALSE;
458     if (flg1) {
459       if (consistent) {
460         ierr = PetscPrintf(PetscObjectComm((PetscObject)sp),"Null vector %D is likely null vector",j);CHKERRQ(ierr);
461       } else {
462         ierr       = PetscPrintf(PetscObjectComm((PetscObject)sp),"Null vector %D unlikely null vector ",j);CHKERRQ(ierr);
463         consistent = PETSC_FALSE;
464       }
465       ierr = PetscPrintf(PetscObjectComm((PetscObject)sp),"|| A * v[%D] || = %g\n",j,(double)nrm);CHKERRQ(ierr);
466     }
467     if (!consistent && flg1) {ierr = VecView(l,viewer);CHKERRQ(ierr);}
468     if (!consistent && flg2) {ierr = VecView(l,viewer);CHKERRQ(ierr);}
469   }
470 
471   if (sp->remove) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot test a null space provided as a function with MatNullSpaceSetFunction()");
472   ierr = VecDestroy(&l);CHKERRQ(ierr);
473   if (isNull) *isNull = consistent;
474   PetscFunctionReturn(0);
475 }
476 
477