xref: /petsc/src/mat/interface/matnull.c (revision 2dcb1b2a648e6798dfef446393ab7396b79ac556)
1 #define PETSCMAT_DLL
2 
3 /*
4     Routines to project vectors out of null spaces.
5 */
6 
7 #include "src/mat/matimpl.h"      /*I "petscmat.h" I*/
8 #include "petscsys.h"
9 
10 PetscCookie PETSCMAT_DLLEXPORT MAT_NULLSPACE_COOKIE = 0;
11 
12 #undef __FUNCT__
13 #define __FUNCT__ "MatNullSpaceCreate"
14 /*@C
15    MatNullSpaceCreate - Creates a data structure used to project vectors
16    out of null spaces.
17 
18    Collective on MPI_Comm
19 
20    Input Parameters:
21 +  comm - the MPI communicator associated with the object
22 .  has_cnst - PETSC_TRUE if the null space contains the constant vector; otherwise PETSC_FALSE
23 .  n - number of vectors (excluding constant vector) in null space
24 -  vecs - the vectors that span the null space (excluding the constant vector);
25           these vectors must be orthonormal. These vectors are NOT copied, so do not change them
26           after this call. You should free the array that you pass in.
27 
28    Output Parameter:
29 .  SP - the null space context
30 
31    Level: advanced
32 
33   Users manual sections:
34 .   sec_singular
35 
36 .keywords: PC, null space, create
37 
38 .seealso: MatNullSpaceDestroy(), MatNullSpaceRemove(), KSPSetNullSpace(), MatNullSpace
39 @*/
40 PetscErrorCode PETSCMAT_DLLEXPORT MatNullSpaceCreate(MPI_Comm comm,PetscTruth has_cnst,PetscInt n,const Vec vecs[],MatNullSpace *SP)
41 {
42   MatNullSpace   sp;
43   PetscErrorCode ierr;
44   PetscInt       i;
45 
46   PetscFunctionBegin;
47   ierr = PetscHeaderCreate(sp,_p_MatNullSpace,int,MAT_NULLSPACE_COOKIE,0,"MatNullSpace",comm,MatNullSpaceDestroy,0);CHKERRQ(ierr);
48   ierr = PetscLogObjectMemory(sp,sizeof(struct _p_MatNullSpace));CHKERRQ(ierr);
49 
50   sp->has_cnst = has_cnst;
51   sp->n        = n;
52   sp->vec      = PETSC_NULL;
53   if (n) {
54     ierr = PetscMalloc(n*sizeof(Vec),&sp->vecs);CHKERRQ(ierr);
55     for (i=0; i<n; i++) sp->vecs[i] = vecs[i];
56   } else {
57     sp->vecs = 0;
58   }
59 
60   for (i=0; i<n; i++) {
61     ierr = PetscObjectReference((PetscObject)sp->vecs[i]);CHKERRQ(ierr);
62   }
63   *SP          = sp;
64   PetscFunctionReturn(0);
65 }
66 
67 #undef __FUNCT__
68 #define __FUNCT__ "MatNullSpaceDestroy"
69 /*@
70    MatNullSpaceDestroy - Destroys a data structure used to project vectors
71    out of null spaces.
72 
73    Collective on MatNullSpace
74 
75    Input Parameter:
76 .  sp - the null space context to be destroyed
77 
78    Level: advanced
79 
80 .keywords: PC, null space, destroy
81 
82 .seealso: MatNullSpaceCreate(), MatNullSpaceRemove()
83 @*/
84 PetscErrorCode PETSCMAT_DLLEXPORT MatNullSpaceDestroy(MatNullSpace sp)
85 {
86   PetscErrorCode ierr;
87 
88   PetscFunctionBegin;
89   if (--sp->refct > 0) PetscFunctionReturn(0);
90 
91   if (sp->vec) {ierr = VecDestroy(sp->vec);CHKERRQ(ierr);}
92   if (sp->vecs) {
93     ierr = VecDestroyVecs(sp->vecs,sp->n);CHKERRQ(ierr);
94   }
95   ierr = PetscHeaderDestroy(sp);CHKERRQ(ierr);
96   PetscFunctionReturn(0);
97 }
98 
99 #undef __FUNCT__
100 #define __FUNCT__ "MatNullSpaceRemove"
101 /*@
102    MatNullSpaceRemove - Removes all the components of a null space from a vector.
103 
104    Collective on MatNullSpace
105 
106    Input Parameters:
107 +  sp - the null space context
108 .  vec - the vector from which the null space is to be removed
109 -  out - if this is requested (not PETSC_NULL) then this is a vector with the null space removed otherwise
110          the removal is done in-place (in vec)
111 
112 
113 
114    Level: advanced
115 
116 .keywords: PC, null space, remove
117 
118 .seealso: MatNullSpaceCreate(), MatNullSpaceDestroy()
119 @*/
120 PetscErrorCode PETSCMAT_DLLEXPORT MatNullSpaceRemove(MatNullSpace sp,Vec vec,Vec *out)
121 {
122   PetscScalar    sum;
123   PetscErrorCode ierr;
124   PetscInt       j,n = sp->n,N;
125   Vec            l = vec;
126 
127   PetscFunctionBegin;
128   if (out) {
129     if (!sp->vec) {
130       ierr = VecDuplicate(vec,&sp->vec);CHKERRQ(ierr);
131     }
132     *out = sp->vec;
133     ierr = VecCopy(vec,*out);CHKERRQ(ierr);
134     l    = *out;
135   }
136 
137   if (sp->has_cnst) {
138     ierr = VecSum(l,&sum);CHKERRQ(ierr);
139     ierr = VecGetSize(l,&N);CHKERRQ(ierr);
140     sum  = sum/(-1.0*N);
141     ierr = VecShift(l,sum);CHKERRQ(ierr);
142   }
143 
144   for (j=0; j<n; j++) {
145     ierr = VecDot(l,sp->vecs[j],&sum);CHKERRQ(ierr);
146     sum  = -sum;
147     ierr = VecAXPY(l,sum,sp->vecs[j]);CHKERRQ(ierr);
148   }
149 
150   PetscFunctionReturn(0);
151 }
152 
153 #undef __FUNCT__
154 #define __FUNCT__ "MatNullSpaceTest"
155 /*@
156    MatNullSpaceTest  - Tests if the claimed null space is really a
157      null space of a matrix
158 
159    Collective on MatNullSpace
160 
161    Input Parameters:
162 +  sp - the null space context
163 -  mat - the matrix
164 
165    Level: advanced
166 
167 .keywords: PC, null space, remove
168 
169 .seealso: MatNullSpaceCreate(), MatNullSpaceDestroy()
170 @*/
171 PetscErrorCode PETSCMAT_DLLEXPORT MatNullSpaceTest(MatNullSpace sp,Mat mat)
172 {
173   PetscScalar    sum;
174   PetscReal      nrm;
175   PetscInt       j,n = sp->n,N,m;
176   PetscErrorCode ierr;
177   Vec            l,r;
178   MPI_Comm       comm = sp->comm;
179   PetscTruth     flg1,flg2;
180 
181   PetscFunctionBegin;
182   ierr = PetscOptionsHasName(PETSC_NULL,"-mat_null_space_test_view",&flg1);CHKERRQ(ierr);
183   ierr = PetscOptionsHasName(PETSC_NULL,"-mat_null_space_test_view_draw",&flg2);CHKERRQ(ierr);
184 
185   if (!sp->vec) {
186     if (n) {
187       ierr = VecDuplicate(sp->vecs[0],&sp->vec);CHKERRQ(ierr);
188     } else {
189       ierr = MatGetLocalSize(mat,&m,PETSC_NULL);CHKERRQ(ierr);
190       ierr = VecCreateMPI(sp->comm,m,PETSC_DETERMINE,&sp->vec);CHKERRQ(ierr);
191     }
192   }
193   l    = sp->vec;
194 
195   if (sp->has_cnst) {
196     ierr = VecDuplicate(l,&r);CHKERRQ(ierr);
197     ierr = VecGetSize(l,&N);CHKERRQ(ierr);
198     sum  = 1.0/N;
199     ierr = VecSet(l,sum);CHKERRQ(ierr);
200     ierr = MatMult(mat,l,r);CHKERRQ(ierr);
201     ierr = VecNorm(r,NORM_2,&nrm);CHKERRQ(ierr);
202     if (nrm < 1.e-7) {ierr = PetscPrintf(comm,"Constants are likely null vector");CHKERRQ(ierr);}
203     else {ierr = PetscPrintf(comm,"Constants are unlikely null vector ");CHKERRQ(ierr);}
204     ierr = PetscPrintf(comm,"|| A * 1 || = %g\n",nrm);CHKERRQ(ierr);
205     if (nrm > 1.e-7 && flg1) {ierr = VecView(r,PETSC_VIEWER_STDOUT_(comm));CHKERRQ(ierr);}
206     if (nrm > 1.e-7 && flg2) {ierr = VecView(r,PETSC_VIEWER_DRAW_(comm));CHKERRQ(ierr);}
207     ierr = VecDestroy(r);CHKERRQ(ierr);
208   }
209 
210   for (j=0; j<n; j++) {
211     ierr = (*mat->ops->mult)(mat,sp->vecs[j],l);CHKERRQ(ierr);
212     ierr = VecNorm(l,NORM_2,&nrm);CHKERRQ(ierr);
213     if (nrm < 1.e-7) {ierr = PetscPrintf(comm,"Null vector %D is likely null vector",j);CHKERRQ(ierr);}
214     else {ierr = PetscPrintf(comm,"Null vector %D unlikely null vector ",j);CHKERRQ(ierr);}
215     ierr = PetscPrintf(comm,"|| A * v[%D] || = %g\n",j,nrm);CHKERRQ(ierr);
216     if (nrm > 1.e-7 && flg1) {ierr = VecView(l,PETSC_VIEWER_STDOUT_(comm));CHKERRQ(ierr);}
217     if (nrm > 1.e-7 && flg2) {ierr = VecView(l,PETSC_VIEWER_DRAW_(comm));CHKERRQ(ierr);}
218   }
219 
220   PetscFunctionReturn(0);
221 }
222 
223