Actual source code: slepcutil.c
1: /*
2: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3: SLEPc - Scalable Library for Eigenvalue Problem Computations
4: Copyright (c) 2002-2010, Universidad Politecnica de Valencia, Spain
6: This file is part of SLEPc.
7:
8: SLEPc is free software: you can redistribute it and/or modify it under the
9: terms of version 3 of the GNU Lesser General Public License as published by
10: the Free Software Foundation.
12: SLEPc is distributed in the hope that it will be useful, but WITHOUT ANY
13: WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
14: FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for
15: more details.
17: You should have received a copy of the GNU Lesser General Public License
18: along with SLEPc. If not, see <http://www.gnu.org/licenses/>.
19: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
20: */
22: #include slepcsys.h
23: #include "petscblaslapack.h"
24: #include <stdlib.h>
26: PetscLogEvent SLEPC_UpdateVectors = 0, SLEPC_VecMAXPBY = 0;
30: /*@
31: SlepcVecSetRandom - Sets all components of a vector to random numbers.
33: Collective on Vec
35: Input/Output Parameter:
36: . x - the vector
38: Input Parameter:
39: - rctx - the random number context, formed by PetscRandomCreate(), or PETSC_NULL and
40: it will create one internally.
42: Note:
43: This operation is equivalent to VecSetRandom - the difference is that the
44: vector generated by SlepcVecSetRandom is the same irrespective of the size
45: of the communicator.
47: Level: developer
48: @*/
49: PetscErrorCode SlepcVecSetRandom(Vec x,PetscRandom rctx)
50: {
52: PetscRandom randObj = PETSC_NULL;
53: PetscInt i,n,low,high;
54: PetscScalar *px,t;
55:
59: if (!rctx) {
60: MPI_Comm comm;
61: PetscObjectGetComm((PetscObject)x,&comm);
62: PetscRandomCreate(comm,&randObj);
63: PetscRandomSetFromOptions(randObj);
64: rctx = randObj;
65: }
67: VecGetSize(x,&n);
68: VecGetOwnershipRange(x,&low,&high);
69: VecGetArray(x,&px);
70: for (i=0;i<n;i++) {
71: PetscRandomGetValue(rctx,&t);
72: if (i>=low && i<high) px[i-low] = t;
73: }
74: VecRestoreArray(x,&px);
75: if (randObj) {
76: PetscRandomDestroy(randObj);
77: }
78: PetscObjectStateIncrease((PetscObject)x);
79: return(0);
80: }
84: /*@
85: SlepcIsHermitian - Checks if a matrix is Hermitian or not.
87: Collective on Mat
89: Input parameter:
90: . A - the matrix
92: Output parameter:
93: . is - flag indicating if the matrix is Hermitian
95: Notes:
96: The result of Ax and A^Hx (with a random x) is compared, but they
97: could be equal also for some non-Hermitian matrices.
99: This routine will not work with matrix formats MATSEQSBAIJ or MATMPISBAIJ,
100: or when PETSc is configured with complex scalars.
101:
102: Level: developer
104: @*/
105: PetscErrorCode SlepcIsHermitian(Mat A,PetscTruth *is)
106: {
108: PetscInt M,N,m,n;
109: Vec x,w1,w2;
110: MPI_Comm comm;
111: PetscReal norm;
112: PetscTruth has;
116: #if !defined(PETSC_USE_COMPLEX)
117: PetscTypeCompare((PetscObject)A,MATSEQSBAIJ,is);
118: if (*is) return(0);
119: PetscTypeCompare((PetscObject)A,MATMPISBAIJ,is);
120: if (*is) return(0);
121: #endif
123: *is = PETSC_FALSE;
124: MatGetSize(A,&M,&N);
125: MatGetLocalSize(A,&m,&n);
126: if (M!=N) return(0);
127: MatHasOperation(A,MATOP_MULT,&has);
128: if (!has) return(0);
129: MatHasOperation(A,MATOP_MULT_TRANSPOSE,&has);
130: if (!has) return(0);
132: PetscObjectGetComm((PetscObject)A,&comm);
133: VecCreate(comm,&x);
134: VecSetSizes(x,n,N);
135: VecSetFromOptions(x);
136: SlepcVecSetRandom(x,PETSC_NULL);
137: VecDuplicate(x,&w1);
138: VecDuplicate(x,&w2);
139: MatMult(A,x,w1);
140: MatMultTranspose(A,x,w2);
141: VecConjugate(w2);
142: VecAXPY(w2,-1.0,w1);
143: VecNorm(w2,NORM_2,&norm);
144: if (norm<1.0e-6) *is = PETSC_TRUE;
145: VecDestroy(x);
146: VecDestroy(w1);
147: VecDestroy(w2);
149: return(0);
150: }
152: #if !defined(PETSC_USE_COMPLEX)
156: /*@C
157: SlepcAbsEigenvalue - Returns the absolute value of a complex number given
158: its real and imaginary parts.
160: Not collective
162: Input parameters:
163: + x - the real part of the complex number
164: - y - the imaginary part of the complex number
166: Notes:
167: This function computes sqrt(x**2+y**2), taking care not to cause unnecessary
168: overflow. It is based on LAPACK's DLAPY2.
170: Level: developer
172: @*/
173: PetscReal SlepcAbsEigenvalue(PetscScalar x,PetscScalar y)
174: {
175: PetscReal xabs,yabs,w,z,t;
177: xabs = PetscAbsReal(x);
178: yabs = PetscAbsReal(y);
179: w = PetscMax(xabs,yabs);
180: z = PetscMin(xabs,yabs);
181: if (z == 0.0) PetscFunctionReturn(w);
182: t = z/w;
183: PetscFunctionReturn(w*sqrt(1.0+t*t));
184: }
186: #endif
190: /*@C
191: SlepcVecNormalize - Normalizes a possibly complex vector by the 2-norm.
193: Not collective
195: Input parameters:
196: + xr - the real part of the vector (overwritten on output)
197: + xi - the imaginary part of the vector (not referenced if iscomplex is false)
198: - iscomplex - a flag that indicating if the vector is complex
200: Output parameter:
201: . norm - the vector norm before normalization (can be set to PETSC_NULL)
203: Level: developer
205: @*/
206: PetscErrorCode SlepcVecNormalize(Vec xr,Vec xi,PetscTruth iscomplex,PetscReal *norm)
207: {
209: #if !defined(PETSC_USE_COMPLEX)
210: PetscReal normr,normi,alpha;
211: #endif
214: #if !defined(PETSC_USE_COMPLEX)
215: if (iscomplex) {
216: VecNorm(xr,NORM_2,&normr);
217: VecNorm(xi,NORM_2,&normi);
218: alpha = SlepcAbsEigenvalue(normr,normi);
219: if (norm) *norm = alpha;
220: alpha = 1.0 / alpha;
221: VecScale(xr,alpha);
222: VecScale(xi,alpha);
223: } else
224: #endif
225: {
226: VecNormalize(xr,norm);
227: }
228: return(0);
229: }
233: /*@C
234: SlepcMatConvertSeqDense - Converts a parallel matrix to another one in sequential
235: dense format replicating the values in every processor.
237: Collective
239: Input parameters:
240: + A - the source matrix
241: - B - the target matrix
243: Level: developer
244:
245: @*/
246: PetscErrorCode SlepcMatConvertSeqDense(Mat mat,Mat *newmat)
247: {
249: PetscInt m,n;
250: PetscMPIInt size;
251: MPI_Comm comm;
252: Mat *M;
253: IS isrow, iscol;
254: PetscTruth flg;
260: PetscObjectGetComm((PetscObject)mat,&comm);
261: MPI_Comm_size(comm,&size);
263: if (size > 1) {
264: /* assemble full matrix on every processor */
265: MatGetSize(mat,&m,&n);
266: ISCreateStride(PETSC_COMM_SELF,m,0,1,&isrow);
267: ISCreateStride(PETSC_COMM_SELF,n,0,1,&iscol);
268: MatGetSubMatrices(mat,1,&isrow,&iscol,MAT_INITIAL_MATRIX,&M);
269: ISDestroy(isrow);
270: ISDestroy(iscol);
272: /* Fake support for "inplace" convert */
273: if (*newmat == mat) {
274: MatDestroy(mat);
275: }
276: *newmat = *M;
277: PetscFree(M);
278:
279: /* convert matrix to MatSeqDense */
280: PetscTypeCompare((PetscObject)*newmat,MATSEQDENSE,&flg);
281: if (!flg) {
282: MatConvert(*newmat,MATSEQDENSE,MAT_INITIAL_MATRIX,newmat);
283: }
284: } else {
285: /* convert matrix to MatSeqDense */
286: MatConvert(mat,MATSEQDENSE,MAT_INITIAL_MATRIX,newmat);
287: }
289: return(0);
290: }
294: /*@
295: SlepcCheckOrthogonality - Checks (or prints) the level of orthogonality
296: of a set of vectors.
298: Collective on Vec
300: Input parameters:
301: + V - a set of vectors
302: . nv - number of V vectors
303: . W - an alternative set of vectors (optional)
304: . nw - number of W vectors
305: - B - matrix defining the inner product (optional)
307: Output parameter:
308: . lev - level of orthogonality (optional)
310: Notes:
311: This function computes W'*V and prints the result. It is intended to check
312: the level of bi-orthogonality of the vectors in the two sets. If W is equal
313: to PETSC_NULL then V is used, thus checking the orthogonality of the V vectors.
315: If matrix B is provided then the check uses the B-inner product, W'*B*V.
317: If lev is not PETSC_NULL, it will contain the level of orthogonality
318: computed as ||W'*V - I|| in the Frobenius norm. Otherwise, the matrix W'*V
319: is printed.
321: Level: developer
323: @*/
324: PetscErrorCode SlepcCheckOrthogonality(Vec *V,PetscInt nv,Vec *W,PetscInt nw,Mat B,PetscScalar *lev)
325: {
327: PetscInt i,j;
328: PetscScalar *vals;
329: Vec w;
330: MPI_Comm comm;
333: if (nv<=0 || nw<=0) return(0);
334: PetscObjectGetComm((PetscObject)V[0],&comm);
335: PetscMalloc(nv*sizeof(PetscScalar),&vals);
336: if (B) { VecDuplicate(V[0],&w); }
337: if (lev) *lev = 0.0;
338: for (i=0;i<nw;i++) {
339: if (B) {
340: if (W) { MatMultTranspose(B,W[i],w); }
341: else { MatMultTranspose(B,V[i],w); }
342: }
343: else {
344: if (W) w = W[i];
345: else w = V[i];
346: }
347: VecMDot(w,nv,V,vals);
348: for (j=0;j<nv;j++) {
349: if (lev) *lev += (j==i)? (vals[j]-1.0)*(vals[j]-1.0): vals[j]*vals[j];
350: else {
351: #ifndef PETSC_USE_COMPLEX
352: PetscPrintf(comm," %12g ",vals[j]);
353: #else
354: PetscPrintf(comm," %12g%+12gi ",PetscRealPart(vals[j]),PetscImaginaryPart(vals[j]));
355: #endif
356: }
357: }
358: if (!lev) { PetscPrintf(comm,"\n"); }
359: }
360: PetscFree(vals);
361: if (B) { VecDestroy(w); }
362: if (lev) *lev = PetscSqrtScalar(*lev);
363: return(0);
364: }
368: /*@
369: SlepcUpdateVectors - Update a set of vectors V as V(:,s:e-1) = V*Q(:,s:e-1).
371: Collective on Vec
373: Input parameters:
374: + n - number of vectors in V
375: . s - first column of V to be overwritten
376: . e - first column of V not to be overwritten
377: . Q - matrix containing the coefficients of the update
378: . ldq - leading dimension of Q
379: - qtrans - flag indicating if Q is to be transposed
381: Input/Output parameter:
382: . V - set of vectors
384: Notes:
385: This function computes V(:,s:e-1) = V*Q(:,s:e-1), that is, given a set of
386: vectors V, columns from s to e-1 are overwritten with columns from s to
387: e-1 of the matrix-matrix product V*Q.
389: Matrix V is represented as an array of Vec, whereas Q is represented as
390: a column-major dense array of leading dimension ldq. Only columns s to e-1
391: of Q are referenced.
393: If qtrans=PETSC_TRUE, the operation is V*Q'.
395: This routine is implemented with a call to BLAS, therefore V is an array
396: of Vec which have the data stored contiguously in memory as a Fortran matrix.
397: PETSc does not create such arrays by default.
399: Level: developer
401: @*/
402: PetscErrorCode SlepcUpdateVectors(PetscInt n_,Vec *V,PetscInt s,PetscInt e,const PetscScalar *Q,PetscInt ldq_,PetscTruth qtrans)
403: {
408: SlepcUpdateStrideVectors(n_,V,s,1,e,Q,ldq_,qtrans);
409:
410: return(0);
411: }
415: /*@
416: SlepcUpdateStrideVectors - Update a set of vectors V as
417: V(:,s:d:e-1) = V*Q(:,s:e-1).
419: Collective on Vec
421: Input parameters:
422: + n - number of vectors in V
423: . s - first column of V to be overwritten
424: . d - stride
425: . e - first column of V not to be overwritten
426: . Q - matrix containing the coefficients of the update
427: . ldq - leading dimension of Q
428: - qtrans - flag indicating if Q is to be transposed
430: Input/Output parameter:
431: . V - set of vectors
433: Notes:
434: This function computes V(:,s:d:e-1) = V*Q(:,s:e-1), that is, given a set
435: of vectors V, columns from s to e-1 are overwritten with columns from s to
436: e-1 of the matrix-matrix product V*Q.
438: Matrix V is represented as an array of Vec, whereas Q is represented as
439: a column-major dense array of leading dimension ldq. Only columns s to e-1
440: of Q are referenced.
442: If qtrans=PETSC_TRUE, the operation is V*Q'.
444: This routine is implemented with a call to BLAS, therefore V is an array
445: of Vec which have the data stored contiguously in memory as a Fortran matrix.
446: PETSc does not create such arrays by default.
448: Level: developer
450: @*/
451: PetscErrorCode SlepcUpdateStrideVectors(PetscInt n_,Vec *V,PetscInt s,PetscInt d,PetscInt e,const PetscScalar *Q,PetscInt ldq_,PetscTruth qtrans)
452: {
454: PetscInt l;
455: PetscBLASInt i,j,k,bs=64,m,n,ldq,ls,ld;
456: PetscScalar *pv,*pw,*pq,*work,*pwork,one=1.0,zero=0.0;
457: const char *qt;
460: n = PetscBLASIntCast(n_/d);
461: ldq = PetscBLASIntCast(ldq_);
462: m = (e-s)/d;
463: if (m==0) return(0);
465: if (m<0 || n<0 || s<0 || m>n) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Index argument out of range");
466: PetscLogEventBegin(SLEPC_UpdateVectors,0,0,0,0);
467: VecGetLocalSize(V[0],&l);
468: ls = PetscBLASIntCast(l);
469: ld = ls*PetscBLASIntCast(d);
470: VecGetArray(V[0],&pv);
471: if (qtrans) {
472: pq = (PetscScalar*)Q+s;
473: qt = "T";
474: } else {
475: pq = (PetscScalar*)Q+s*ldq;
476: qt = "N";
477: }
478: PetscMalloc(sizeof(PetscScalar)*bs*m,&work);
479: k = ls % bs;
480: if (k) {
481: BLASgemm_("N",qt,&k,&m,&n,&one,pv,&ld,pq,&ldq,&zero,work,&k);
482: for (j=0;j<m;j++) {
483: pw = pv+(s+j)*ld;
484: pwork = work+j*k;
485: for (i=0;i<k;i++) {
486: *pw++ = *pwork++;
487: }
488: }
489: }
490: for (;k<ls;k+=bs) {
491: BLASgemm_("N",qt,&bs,&m,&n,&one,pv+k,&ld,pq,&ldq,&zero,work,&bs);
492: for (j=0;j<m;j++) {
493: pw = pv+(s+j)*ld+k;
494: pwork = work+j*bs;
495: for (i=0;i<bs;i++) {
496: *pw++ = *pwork++;
497: }
498: }
499: }
500: VecRestoreArray(V[0],&pv);
501: PetscFree(work);
502: PetscLogFlops(m*n*2.0*ls);
503: PetscLogEventEnd(SLEPC_UpdateVectors,0,0,0,0);
504: return(0);
505: }
509: /*@
510: SlepcVecMAXPBY - Computes y = beta*y + sum alpha*a[j]*x[j]
512: Collective on Vec
514: Input parameters:
515: + beta - scalar beta
516: . alpha - scalar alpha
517: . nv - number of vectors in x and scalars in a
518: . a - array of scalars
519: - x - set of vectors
521: Input/Output parameter:
522: . y - the vector to update
524: Notes:
525: This routine is implemented with a call to BLAS, therefore x is an array
526: of Vec which have the data stored contiguously in memory as a Fortran matrix.
527: PETSc does not create such arrays by default.
529: Level: developer
531: @*/
532: PetscErrorCode SlepcVecMAXPBY(Vec y,PetscScalar beta,PetscScalar alpha,PetscInt nv,PetscScalar a[],Vec x[])
533: {
535: PetscBLASInt n,m,one=1;
536: PetscScalar *py,*px;
540: if (!nv || !(y)->map->n) return(0);
541: if (nv < 0) SETERRQ1(PETSC_ERR_ARG_OUTOFRANGE,"Number of vectors (given %D) cannot be negative",nv);
548: if ((*x)->map->N != (y)->map->N) SETERRQ(PETSC_ERR_ARG_INCOMP,"Incompatible vector global lengths");
549: if ((*x)->map->n != (y)->map->n) SETERRQ(PETSC_ERR_ARG_INCOMP,"Incompatible vector local lengths");
551: PetscLogEventBegin(SLEPC_VecMAXPBY,*x,y,0,0);
552: VecGetArray(y,&py);
553: VecGetArray(*x,&px);
554: n = PetscBLASIntCast(nv);
555: m = PetscBLASIntCast((y)->map->n);
556: BLASgemv_("N",&m,&n,&alpha,px,&m,a,&one,&beta,py,&one);
557: VecRestoreArray(y,&py);
558: VecRestoreArray(*x,&px);
559: PetscLogFlops(nv*2*(y)->map->n);
560: PetscLogEventEnd(SLEPC_VecMAXPBY,*x,y,0,0);
561: return(0);
562: }