Actual source code: ex53.c
slepc-3.22.1 2024-10-28
1: /*
2: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3: SLEPc - Scalable Library for Eigenvalue Problem Computations
4: Copyright (c) 2002-, Universitat Politecnica de Valencia, Spain
6: This file is part of SLEPc.
7: SLEPc is distributed under a 2-clause BSD license (see LICENSE).
8: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
9: */
11: static char help[] = "Partial hyperbolic singular value decomposition (HSVD) of matrix generated by plane rotations.\n"
12: "The command line options are:\n"
13: " -p <p>, number of rows in upper part of matrix A.\n"
14: " -q <q>, number of rows in lower part of matrix A.\n"
15: " -n <n>, number of columns of matrix A.\n"
16: " -k <k>, condition number.\n"
17: " -d <d>, density.\n"
18: " -prog, show progress of matrix generation\n";
20: #include <slepcsvd.h>
21: #include <slepcblaslapack.h>
23: /* The problem matrix is the (p+q)-by-n matrix
25: A = | Q1 * D1 * U |
26: | 1/2*Q2 * D2 * U |
28: with p>=n, where Q1 (p-by-p), Q2 (q-by-q) and U (n-by-n) are orthonormal
29: matrices, D1 is a diagonal p-by-n matrix with elements
30: D1(i,i) = sqrt(5/4)*d(i), if i<=q
31: = d(i), if i>q
32: D2 is a diagonal q-by-n matrix with elements D2(i,i)= d(i),
33: and d is an n-element vector with elements distributed exponentially
34: from 1/k to 1.
36: The signature matrix is Omega = diag(I_p,-I_q)
38: The hyperbolic singular values of A are equal to the elements of vector d.
40: A is generated by random plane rotations applied to the diagonal matrices
41: D1 and D2
43: This test case is based on the paper:
45: [1] A. Bojanczyk, N.J. Higham, and H. Patel, "Solving the Indefinite Least
46: Squares Problem by Hyperbolic QR Factorization", SIAM J. Matrix Anal.
47: Appl. 24(4):914-931 2003
48: */
50: /* Timing */
51: #ifdef TIMING
52: static PetscReal tt_rotr,tt_rotc,tt_assmr=0.0,tt_assmc=0.0,tt_getr=0.0,tt_getc=0.0,tt_setvalr=0.0,tt_setvalc=0.0;
53: #define time_now(t) t=MPI_Wtime();
54: #define time_diff(tacum,t0,t,t1) {t=MPI_Wtime(); tacum += t-t0; t1=t;}
55: #else
56: #define time_diff(tacum,t0,t,t1)
57: #define time_now(t)
58: #endif
60: struct _p_XMat {
61: MPI_Comm comm;
62: PetscInt M,N; /* global number of rows and columns */
63: PetscInt Istart,Iend; /* Index of 1st row and last local rows */
64: PetscInt *nzr; /* number of non-zeros in each row */
65: PetscInt **rcol; /* row columns */
66: PetscInt *ranges; /* proc row ranges */
67: PetscScalar **rval; /* row values */
68: };
70: typedef struct _p_XMat *XMat;
72: /* Iterator over non-zero rows of 2 columns */
73: struct _p_ColsNzIter {
74: XMat A;
75: PetscInt j1,j2; /* Columns considered */
76: PetscInt iloc; /* current local row */
77: };
79: typedef struct _p_ColsNzIter *ColsNzIter;
81: static PetscErrorCode XMatCreate(MPI_Comm comm,XMat *A,PetscInt Istart,PetscInt Iend,PetscInt M,PetscInt N)
82: {
83: PetscInt i;
84: PetscMPIInt np;
86: PetscFunctionBeginUser;
87: PetscCall(PetscNew(A));
88: (*A)->M = M;
89: (*A)->N = N;
90: (*A)->Istart = Istart;
91: (*A)->Iend = Iend;
92: (*A)->comm = comm;
93: PetscCallMPI(MPI_Comm_size(comm,&np));
94: PetscCall(PetscMalloc4(Iend-Istart,&(*A)->nzr,Iend-Istart,&(*A)->rcol,Iend-Istart,&(*A)->rval,np+1,&(*A)->ranges));
95: for (i=0; i<Iend-Istart; i++) {
96: (*A)->nzr[i] = 0;
97: (*A)->rcol[i] = NULL;
98: (*A)->rval[i] = NULL;
99: }
100: PetscCallMPI(MPI_Allgather(&Istart,1,MPIU_INT,(*A)->ranges,1,MPIU_INT,comm));
101: (*A)->ranges[np]=M;
102: PetscFunctionReturn(PETSC_SUCCESS);
103: }
105: static PetscErrorCode XMatDestroy(XMat *A)
106: {
107: PetscInt m,i;
109: PetscFunctionBeginUser;
110: m = (*A)->Iend-(*A)->Istart;
111: for (i=0; i<m; i++) {
112: if ((*A)->nzr[i]>0) {
113: PetscCall(PetscFree2((*A)->rcol[i],(*A)->rval[i]));
114: }
115: }
116: PetscCall(PetscFree4((*A)->nzr,(*A)->rcol,(*A)->rval,(*A)->ranges));
117: PetscCall(PetscFree(*A));
118: *A = NULL;
119: PetscFunctionReturn(PETSC_SUCCESS);
120: }
122: static PetscErrorCode XMatGetSize(XMat A,PetscInt *M,PetscInt *N)
123: {
124: PetscFunctionBeginUser;
125: *M = A->M;
126: *N = A->N;
127: PetscFunctionReturn(PETSC_SUCCESS);
128: }
130: static PetscErrorCode XMatGetOwnershipRange(XMat A,PetscInt *Istart,PetscInt *Iend)
131: {
132: PetscFunctionBeginUser;
133: *Istart = A->Istart;
134: *Iend = A->Iend;
135: PetscFunctionReturn(PETSC_SUCCESS);
136: }
138: static PetscErrorCode XMatGetOwnershipRanges(XMat A,PetscInt **ranges)
139: {
140: PetscFunctionBeginUser;
141: *ranges = A->ranges;
142: PetscFunctionReturn(PETSC_SUCCESS);
143: }
145: static PetscErrorCode XMatGetRow(XMat A,PetscInt i,PetscInt *nc,PetscInt **vj,PetscScalar **va)
146: {
147: PetscInt iloc=i-A->Istart;
149: PetscFunctionBeginUser;
150: *nc = A->nzr[iloc];
151: *vj = A->rcol[iloc];
152: *va = A->rval[iloc];
153: PetscFunctionReturn(PETSC_SUCCESS);
154: }
156: static PetscErrorCode XMatRestoreRow(XMat A,PetscInt i,PetscInt *nc,PetscInt **vj,PetscScalar **va)
157: {
158: PetscFunctionBeginUser;
159: *nc = 0;
160: *vj = NULL;
161: *va = NULL;
162: PetscFunctionReturn(PETSC_SUCCESS);
163: }
165: static PetscErrorCode XMatChangeRow(XMat A,PetscInt i,PetscInt nc,PetscInt vj[],PetscScalar va[])
166: {
167: PetscInt iloc = i-A->Istart;
169: PetscFunctionBeginUser;
170: if (A->nzr[iloc]>0) {
171: PetscCall(PetscFree2(A->rcol[iloc],A->rval[iloc]));
172: }
173: A->nzr[iloc] = nc;
174: A->rcol[iloc] = vj;
175: A->rval[iloc] = va;
176: PetscFunctionReturn(PETSC_SUCCESS);
177: }
179: /* Given a row with non-zero elements in columns indicated by rcol, get the
180: position where the non-zero element of column j is, or where it should be inserted.
181: Returns true if there is a non-zero element for the column, false otherwise */
182: static PetscBool getcolpos(const PetscInt rcol[],PetscInt nz,PetscInt j,PetscInt *k)
183: {
184: PetscInt ka,kb;
185: if (nz==0) {
186: *k = 0;
187: return PETSC_FALSE;
188: }
189: if (j<=rcol[0]) {
190: *k = 0;
191: return (rcol[0]==j)? PETSC_TRUE: PETSC_FALSE;
192: }
193: if (rcol[nz-1]<=j) {
194: *k = nz-(rcol[nz-1]==j);
195: return (rcol[nz-1]==j)? PETSC_TRUE: PETSC_FALSE;
196: }
197: /* Bisection: rcol[ka] < j < rcol[kb] */
198: ka = 0; kb = nz-1;
199: while (ka+1<kb) {
200: *k = (ka+kb)/2;
201: if (rcol[*k]<=j) {
202: if (rcol[*k]==j) return PETSC_TRUE;
203: else ka = *k;
204: } else kb = *k;
205: }
206: *k = kb;
207: return PETSC_FALSE;
208: }
210: /* Only local elements can be set */
211: static PetscErrorCode XMatSetValue(XMat A,PetscInt i,PetscInt j,PetscScalar x,InsertMode dummy)
212: {
213: PetscInt nz,iloc,k,kx,*col1,*col2;
214: PetscScalar *val1,*val2;
216: PetscFunctionBeginUser;
217: PetscCheck(i>=A->Istart && i<A->Iend && j>=0 && j<A->N,A->comm,PETSC_ERR_ARG_OUTOFRANGE,"Incorrect index of row/column");
218: iloc = i-A->Istart;
219: nz = A->nzr[iloc];
220: col1 = A->rcol[iloc];
221: val1 = A->rval[iloc];
222: if (!getcolpos(col1,nz,j,&k)) {
223: A->nzr[iloc]++;
224: /* Replace row */
225: PetscCall(PetscMalloc2(nz+1,&col2,nz+1,&val2));
226: A->rcol[iloc] = col2;
227: A->rval[iloc] = val2;
228: for (kx=0; kx<k; kx++) {
229: col2[kx] = col1[kx];
230: val2[kx] = val1[kx];
231: }
232: for (; kx<nz; kx++) {
233: col2[kx+1] = col1[kx];
234: val2[kx+1] = val1[kx];
235: }
236: if (nz>0) {
237: PetscCall(PetscFree2(col1,val1));
238: }
239: col1 = col2;
240: val1 = val2;
241: }
242: col1[k] = j;
243: val1[k] = x;
244: PetscFunctionReturn(PETSC_SUCCESS);
245: }
247: /* Convert to PETSc Mat */
248: static PetscErrorCode XMatConvert(XMat XA,Mat A)
249: {
250: PetscInt i,iloc;
252: PetscFunctionBeginUser;
253: for (i=XA->Istart; i<XA->Iend; i++) {
254: iloc = i-XA->Istart;
255: PetscCall(MatSetValues(A,1,&i,XA->nzr[iloc],XA->rcol[iloc],XA->rval[iloc],INSERT_VALUES));
256: }
257: PetscCall(MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY));
258: PetscCall(MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY));
259: PetscFunctionReturn(PETSC_SUCCESS);
260: }
262: /* gets the number of nonzeros in the matrix on this MPI rank */
263: static PetscErrorCode XMatGetNumberNonzeros(XMat A,PetscInt *nz)
264: {
265: PetscInt i;
267: PetscFunctionBeginUser;
268: *nz = 0;
269: for (i=0; i<A->Iend-A->Istart; i++) *nz += A->nzr[i];
270: PetscFunctionReturn(PETSC_SUCCESS);
271: }
273: static PetscErrorCode XMatCreateColsNzIter(XMat A,PetscInt j1,PetscInt j2,ColsNzIter *iter)
274: {
275: PetscFunctionBeginUser;
276: PetscCall(PetscNew(iter));
277: (*iter)->A = A;
278: (*iter)->j1 = j1;
279: (*iter)->j2 = j2;
280: (*iter)->iloc = 0;
281: PetscFunctionReturn(PETSC_SUCCESS);
282: }
284: static PetscErrorCode ColitDestroy(ColsNzIter *iter)
285: {
286: PetscFunctionBeginUser;
287: PetscCall(PetscFree(*iter));
288: PetscFunctionReturn(PETSC_SUCCESS);
289: }
291: static PetscErrorCode ColitNextRow(ColsNzIter iter,PetscInt *i,PetscScalar **paij1,PetscScalar **paij2)
292: {
293: PetscInt iloc = iter->iloc,*rcol,nz,k,k1,k2,kx,jx,*rcol2;
294: PetscScalar *rval,*rval2;
295: PetscBool found1, found2;
296: XMat A=iter->A;
298: PetscFunctionBeginUser;
299: *i = -1;
300: *paij1 = *paij2 = NULL;
301: if (iloc>=0) {
302: rcol = A->rcol[iloc];
303: nz = A->nzr[iloc];
304: while (PETSC_TRUE) {
305: found1 = getcolpos(rcol,nz,iter->j1,&k1);
306: found2 = getcolpos(PetscSafePointerPlusOffset(rcol,k1+found1),nz-k1-found1,iter->j2,&k2);
307: if (found1 || found2) break;
308: iloc++;
309: if (iloc>=A->Iend-A->Istart) {
310: iloc = -1;
311: break;
312: }
313: rcol = A->rcol[iloc];
314: nz = A->nzr[iloc];
315: }
316: if (iloc>=0) {
317: k2 += k1 + 1;
318: rval = A->rval[iloc];
319: *i = A->Istart+iloc;
320: if (!found1 || !found2) {
321: /* Copy row to a new one */
322: rcol2 = rcol;
323: rval2 = rval;
324: PetscCall(PetscMalloc2(nz+1,&rcol,nz+1,&rval));
325: if (found1) {
326: kx = k2;
327: jx = iter->j2;
328: } else {
329: kx = k1;
330: jx = iter->j1;
331: }
332: for (k=0; k<kx; k++) {
333: rcol[k] = rcol2[k];
334: rval[k] = rval2[k];
335: }
336: rcol[kx] = jx;
337: rval[kx] = 0.0;
338: for (k=kx+1; k<nz+1; k++) {
339: rcol[k] = rcol2[k-1];
340: rval[k] = rval2[k-1];
341: }
342: PetscCall(XMatChangeRow(A,*i,nz+1,rcol,rval));
343: }
344: *paij1 = &rval[k1];
345: *paij2 = &rval[k2];
346: iloc++;
347: if (iloc>=A->Iend-A->Istart) iloc = -1;
348: }
349: iter->iloc = iloc;
350: }
351: PetscFunctionReturn(PETSC_SUCCESS);
352: }
354: static PetscErrorCode SendrecvRow(XMat A,PetscInt nc1,const PetscInt vj1[],const PetscScalar va1[],PetscInt i2,PetscInt *nc2,PetscInt vj2[],PetscScalar va2[])
355: {
356: PetscInt *ranges,N=A->N;
357: PetscMPIInt rank,naux,len1,len2;
358: MPI_Status st;
360: PetscFunctionBeginUser;
361: PetscCall(XMatGetOwnershipRanges(A,&ranges));
362: PetscAssertAbort(i2>=0 && i2<A->M,A->comm,PETSC_ERR_ARG_OUTOFRANGE,"Incorrect index of row");
363: /* Find owner of row i2 */
364: rank=0;
365: while (ranges[rank+1]<=i2) rank++;
366: /* Send row i1, receive row i2 */
367: PetscCall(PetscMPIIntCast(nc1,&len1));
368: PetscCall(PetscMPIIntCast(N,&len2));
369: PetscCallMPI(MPI_Sendrecv(vj1,len1,MPIU_INT,rank,0,vj2,len2,MPIU_INT,rank,0,A->comm,&st));
370: PetscCallMPI(MPI_Sendrecv(va1,len1,MPIU_SCALAR,rank,0,va2,len2,MPIU_SCALAR,rank,0,A->comm,MPI_STATUS_IGNORE));
371: PetscCallMPI(MPI_Get_count(&st,MPIU_INT,&naux));
372: *nc2 = (PetscInt)naux;
373: PetscFunctionReturn(PETSC_SUCCESS);
374: }
376: static PetscErrorCode PadRows(PetscInt nc1,const PetscInt vj1[],const PetscScalar va1[],PetscInt nc2,const PetscInt vj2[],const PetscScalar va2[],PetscInt *nc,PetscInt **vjj1,PetscScalar **vaa1,PetscInt **vjj2,PetscScalar **vaa2,PetscInt *iwork,PetscScalar *swork)
377: {
378: PetscInt k1,k2,k,n1=nc1+nc2,*vjjaux=iwork;
379: PetscScalar *vaa1aux=swork,*vaa2aux=swork+n1;
381: PetscFunctionBeginUser;
382: *nc=0;
383: for (k1=k2=k=0; k1<nc1 && k2<nc2; ) {
384: if (vj1[k1]<vj2[k2]) {
385: /* Take next element from first row */
386: vaa1aux[k] = va1[k1];
387: vaa2aux[k] = 0.0;
388: vjjaux[k++] = vj1[k1++];
389: } else if (vj1[k1]>vj2[k2]) {
390: /* Take next element from second row */
391: vaa1aux[k] = 0.0;
392: vaa2aux[k] = va2[k2];
393: vjjaux[k++] = vj2[k2++];
394: } else {
395: /* Take next element from both rows */
396: vaa1aux[k] = va1[k1];
397: vaa2aux[k] = va2[k2++];
398: vjjaux[k++] = vj1[k1++];
399: }
400: }
402: /* We reached the end of one of the rows. Continue with the other one */
403: while (k1<nc1) {
404: /* Take next element from first row */
405: vaa1aux[k] = va1[k1];
406: vaa2aux[k] = 0.0;
407: vjjaux[k++] = vj1[k1++];
408: }
409: while (k2<nc2) {
410: /* Take next element from second row */
411: vaa1aux[k] = 0.0;
412: vaa2aux[k] = va2[k2];
413: vjjaux[k++] = vj2[k2++];
414: }
415: *nc=k;
417: /* Copy rows (each row must be allocated separately)*/
418: PetscCall(PetscMalloc2(k,vjj1,k,vaa1));
419: PetscCall(PetscMalloc2(k,vjj2,k,vaa2));
420: PetscCall(PetscArraycpy(*vjj1,vjjaux,k));
421: PetscCall(PetscArraycpy(*vjj2,vjjaux,k));
422: PetscCall(PetscArraycpy(*vaa1,vaa1aux,k));
423: PetscCall(PetscArraycpy(*vaa2,vaa2aux,k));
424: PetscFunctionReturn(PETSC_SUCCESS);
425: }
427: static inline void MyAxpby(PetscInt n,PetscScalar a,PetscScalar x[],PetscScalar b,const PetscScalar y[])
428: {
429: PetscInt i;
431: for (i=0; i<n; i++) x[i] = a*x[i]+b*y[i];
432: }
434: /* Apply plane rotation on rows i1, i2 of A */
435: static PetscErrorCode RotateRows(XMat A,PetscInt i1,PetscInt i2,PetscReal c,PetscReal s,PetscInt *nzloc,PetscInt *iwork,PetscScalar *swork)
436: {
437: PetscInt M,N,Istart,Iend,nc,nc1,nc2,*vj1=NULL,*vj2=NULL,*vjj1=NULL,*vjj2=NULL,*iworkx=iwork;
438: PetscBLASInt nc_,one=1;
439: PetscScalar *va1=NULL,*va2=NULL,*vaa1=NULL,*vaa2=NULL,*sworkx=swork;
440: PetscBool i1mine, i2mine;
441: #ifdef TIMING
442: PetscReal t,t0;
443: #endif
445: PetscFunctionBeginUser;
446: PetscCall(XMatGetOwnershipRange(A,&Istart,&Iend));
447: i1mine = (Istart<=i1 && i1<Iend)? PETSC_TRUE: PETSC_FALSE;
448: i2mine = (Istart<=i2 && i2<Iend)? PETSC_TRUE: PETSC_FALSE;
450: if (i1mine || i2mine) {
451: PetscCall(XMatGetSize(A,&M,&N));
453: /* Get local row(s) (at least 1, possibly 2) */
454: time_now(t0);
455: if (i1mine) PetscCall(XMatGetRow(A,i1,&nc1,&vj1,&va1));
456: if (i2mine) PetscCall(XMatGetRow(A,i2,&nc2,&vj2,&va2));
457: time_diff(tt_getr,t0,t,t0);
458: /* Get remote row (at most 1, possibly none) */
459: if (!i2mine) {
460: vj2 = iworkx;
461: iworkx += N;
462: va2 = sworkx;
463: sworkx += N;
464: PetscCall(SendrecvRow(A,nc1,vj1,va1,i2,&nc2,vj2,va2));
465: } else if (!i1mine) {
466: vj1 = iworkx;
467: iworkx += N;
468: va1 = sworkx;
469: sworkx += N;
470: PetscCall(SendrecvRow(A,nc2,vj2,va2,i1,&nc1,vj1,va1));
471: }
473: PetscCall(PadRows(nc1,vj1,va1,nc2,vj2,va2,&nc,&vjj1,&vaa1,&vjj2,&vaa2,iworkx,sworkx));
474: if (i1mine) {
475: *nzloc += nc-nc1;
476: PetscCall(XMatRestoreRow(A,i1,&nc1,&vj1,&va1));
477: }
478: if (i2mine) {
479: *nzloc += nc-nc2;
480: PetscCall(XMatRestoreRow(A,i2,&nc2,&vj2,&va2));
481: }
483: /* Compute rotation and update matrix */
484: if (nc) {
485: PetscCall(PetscBLASIntCast(nc,&nc_));
486: if (i1mine && i2mine) PetscCallBLAS("BLASrot",BLASMIXEDrot_(&nc_,vaa1,&one,vaa2,&one,&c,&s));
487: else if (i1mine) {
488: MyAxpby(nc,c,vaa1,s,vaa2);
489: PetscCall(PetscFree2(vjj2,vaa2));
490: } else {
491: MyAxpby(nc,c,vaa2,-s,vaa1);
492: PetscCall(PetscFree2(vjj1,vaa1));
493: }
494: time_now(t0);
495: if (i1mine) PetscCall(XMatChangeRow(A,i1,nc,vjj1,vaa1));
496: if (i2mine) PetscCall(XMatChangeRow(A,i2,nc,vjj2,vaa2));
497: time_diff(tt_setvalr,t0,t,t0);
498: }
499: }
500: PetscFunctionReturn(PETSC_SUCCESS);
501: }
503: /* Apply plane rotation on columns j1, j2 of A */
504: static PetscErrorCode RotateCols(XMat A,PetscInt j1,PetscInt j2,PetscReal c,PetscReal s,PetscInt *nzloc)
505: {
506: PetscInt i;
507: PetscScalar aux1,aux2,*paij1,*paij2;
508: ColsNzIter iter;
510: PetscFunctionBeginUser;
511: PetscCall(XMatCreateColsNzIter(A,j1,j2,&iter));
512: while (PETSC_TRUE) {
513: PetscCall(ColitNextRow(iter,&i,&paij1,&paij2));
514: if (i<0) break;
515: if (*paij1**paij2==0.0) (*nzloc)++;
516: aux1 = *paij1*c+*paij2*s;
517: aux2 = -*paij1*s+*paij2*c;
518: *paij1 = aux1;
519: *paij2 = aux2;
520: }
521: PetscCall(ColitDestroy(&iter));
522: PetscFunctionReturn(PETSC_SUCCESS);
523: }
525: /* Generate a pair of indices i1, i2, where 0 <= i1 < i2 < n */
526: static PetscErrorCode GetIndexPair(PetscRandom rand,PetscInt n,PetscInt *i1,PetscInt *i2)
527: {
528: PetscInt aux;
529: PetscReal x;
531: PetscFunctionBeginUser;
532: PetscCall(PetscRandomGetValueReal(rand,&x));
533: *i1 = (PetscInt)(x*n);
534: PetscCall(PetscRandomGetValueReal(rand,&x));
535: *i2 = (PetscInt)(x*(n-1));
536: if (*i2>=*i1) (*i2)++;
537: if (*i1>*i2) {
538: aux = *i1;
539: *i1 = *i2;
540: *i2 = aux;
541: }
542: PetscFunctionReturn(PETSC_SUCCESS);
543: }
545: int main(int argc,char **argv)
546: {
547: Mat A,Omega; /* operator matrix, signature matrix */
548: XMat XA;
549: SVD svd; /* singular value problem solver context */
550: Vec u,v,vomega,*U,*V;
551: MatType Atype;
552: PetscReal tol,lev1=0.0,lev2=0.0,k=1e3,dens=0.1,log0,loginc,sq,x,angle,c,s;
553: PetscScalar *swork;
554: PetscInt P=110,Q=80,N=100,i,j,Istart,Iend,nconv,nsv,i1,i2,nroth,nrotv,*iwork,nnzwanted,nz,nzloc;
555: PetscBool flg,flgp,flgq,flgn,terse,skiporth=PETSC_FALSE,progress=PETSC_FALSE;
556: PetscRandom rand;
557: MatInfo Ainfo;
558: #ifdef TIMING
559: PetscReal t,t0;
560: #endif
562: PetscFunctionBeginUser;
563: PetscCall(SlepcInitialize(&argc,&argv,NULL,help));
565: PetscCall(PetscOptionsGetInt(NULL,NULL,"-p",&P,&flgp));
566: PetscCall(PetscOptionsGetInt(NULL,NULL,"-q",&Q,&flgq));
567: PetscCall(PetscOptionsGetInt(NULL,NULL,"-n",&N,&flgn));
568: PetscCall(PetscOptionsGetReal(NULL,NULL,"-k",&k,&flg));
569: PetscCall(PetscOptionsGetReal(NULL,NULL,"-d",&dens,&flg));
570: PetscCall(PetscOptionsGetBool(NULL,NULL,"-prog",&progress,&flg));
571: if (!flgp && flgn) P=N;
572: if (!flgq && flgn) Q=N;
573: PetscCheck(P>=N,PETSC_COMM_WORLD,PETSC_ERR_USER_INPUT,"Parameter p must be >= n");
574: PetscCheck(k>=1.0,PETSC_COMM_WORLD,PETSC_ERR_USER_INPUT,"Parameter k must be >= 1.0");
575: PetscCheck(dens<=1.0,PETSC_COMM_WORLD,PETSC_ERR_USER_INPUT,"Parameter d must be <= 1.0");
577: /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
578: Build matrix that defines the hyperbolic singular value problem
579: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
581: PetscCall(PetscPrintf(PETSC_COMM_WORLD,"\nHyperbolic singular value problem.\n\n"));
582: PetscCall(PetscPrintf(PETSC_COMM_WORLD,"\n Matrix dimensions: (%" PetscInt_FMT "+%" PetscInt_FMT ")x%" PetscInt_FMT,P,Q,N));
583: PetscCall(PetscPrintf(PETSC_COMM_WORLD,", using signature Omega=blkdiag(I_%" PetscInt_FMT ",-I_%" PetscInt_FMT ")\n\n",P,Q));
585: PetscCall(MatCreate(PETSC_COMM_WORLD,&A));
586: PetscCall(MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,P+Q,N));
587: PetscCall(MatSetFromOptions(A));
588: PetscCall(MatSetOption(A,MAT_IGNORE_OFF_PROC_ENTRIES,PETSC_TRUE));
590: /* Set diagonals */
591: PetscCall(MatGetOwnershipRange(A,&Istart,&Iend));
593: PetscCall(XMatCreate(MPI_COMM_WORLD,&XA,Istart,Iend,P+Q,N));
594: log0 = PetscLogReal(1/k);
595: loginc = -log0/(N-1);
596: sq = PetscSqrtReal(5.0/4.0);
597: for (i=Istart;i<Iend;i++) {
598: if (i<P && i<N) {
599: if (i<Q) x = sq*PetscExpReal(log0+i*loginc);
600: else x = PetscExpReal(log0+i*loginc);
601: PetscCall(XMatSetValue(XA,i,i,x,INSERT_VALUES));
602: } else if (i>=P && i-P<N) {
603: j = i-P;
604: PetscCall(XMatSetValue(XA,i,j,PetscExpReal(log0+j*loginc),INSERT_VALUES));
605: }
606: }
608: /* Apply plane rotations */
609: nnzwanted = dens*(P+Q)*N;
610: PetscCall(XMatGetNumberNonzeros(XA,&nzloc));
611: PetscCallMPI(MPI_Allreduce(&nzloc,&nz,1,MPIU_INT,MPI_SUM,MPI_COMM_WORLD));
612: PetscCall(PetscRandomCreate(PETSC_COMM_SELF,&rand));
613: PetscCall(PetscRandomSetFromOptions(rand));
614: nroth = nrotv = 0;
615: PetscCall(PetscMalloc2(2*N,&iwork,3*N,&swork));
616: time_now(t0);
617: while (nz<0.95*nnzwanted) {
618: /* Plane rotation on 2 of the top P rows*/
619: PetscCall(PetscRandomGetValueReal(rand,&angle));
620: c=PetscCosReal(angle);
621: s=PetscSinReal(angle);
622: PetscCall(GetIndexPair(rand,P,&i1,&i2));
623: PetscCall(RotateRows(XA,i1,i2,c,s,&nzloc,iwork,swork));
624: time_diff(tt_rotr,t0,t,t0);
625: nroth++;
626: /* Plane rotation on 2 of the bottom Q rows*/
627: if (Q>1) {
628: PetscCall(PetscRandomGetValueReal(rand,&angle));
629: c=PetscCosReal(angle);
630: s=PetscSinReal(angle);
631: PetscCall(GetIndexPair(rand,Q,&i1,&i2));
632: PetscCall(RotateRows(XA,P+i1,P+i2,c,s,&nzloc,iwork,swork));
633: time_diff(tt_rotr,t0,t,t0);
634: nroth++;
635: }
636: /* Plane rotation on 2 columns */
637: PetscCall(PetscRandomGetValueReal(rand,&angle));
638: c=PetscCosReal(angle);
639: s=PetscSinReal(angle);
640: PetscCall(GetIndexPair(rand,N,&i1,&i2));
641: PetscCall(RotateCols(XA,i1,i2,c,s,&nzloc));
642: time_diff(tt_rotc,t0,t,t0);
643: nrotv++;
644: /* Update total number of non-zeros */
645: PetscCallMPI(MPI_Allreduce(&nzloc,&nz,1,MPIU_INT,MPI_SUM,MPI_COMM_WORLD));
646: if (progress) PetscCall(PetscFPrintf(MPI_COMM_WORLD,stderr,"\rProgress: %.2f%%",(double)nz/nnzwanted*100));
647: }
648: if (progress) PetscCall(PetscFPrintf(MPI_COMM_WORLD,stderr,"\r"));
650: PetscCall(PetscFree2(iwork,swork));
651: PetscCall(PetscRandomDestroy(&rand));
653: PetscCall(XMatConvert(XA,A));
654: PetscCall(XMatDestroy(&XA));
655: PetscCall(MatGetInfo(A,MAT_GLOBAL_SUM,&Ainfo));
656: PetscCall(PetscPrintf(MPI_COMM_WORLD," Matrix created. %" PetscInt_FMT " rotations applied. nnz=%.0f. Density: %.4g\n\n",nroth+nrotv,Ainfo.nz_used,(double)Ainfo.nz_used/(1.0*(P+Q)*N)));
658: #ifdef TIMING
659: PetscCall(PetscPrintf(MPI_COMM_WORLD,"#T rot-rows: %6.3f get-rows: %6.3f setval-rows: %6.3f assm-rows: %.3f\n",tt_rotr,tt_getr,tt_setvalr,tt_assmr));
660: PetscCall(PetscPrintf(MPI_COMM_WORLD,"#T rot cols: %6.3f get-cols: %6.3f setval-cols: %6.3f assm-cols: %.3f\n",tt_rotc,tt_getc,tt_setvalc,tt_assmc));
661: #endif
663: /* scale by 0.5 the lower Q rows of A */
664: PetscCall(MatCreateVecs(A,NULL,&vomega));
665: PetscCall(VecSet(vomega,1.0));
666: for (i=PetscMax(P,Istart);i<Iend;i++) {
667: PetscCall(VecSetValue(vomega,i,0.5,INSERT_VALUES));
668: }
669: PetscCall(VecAssemblyBegin(vomega));
670: PetscCall(VecAssemblyEnd(vomega));
671: PetscCall(MatDiagonalScale(A,vomega,NULL));
673: /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
674: Create the signature
675: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
677: PetscCall(VecSet(vomega,1.0));
678: PetscCall(VecGetOwnershipRange(vomega,&Istart,&Iend));
679: for (i=Istart;i<Iend;i++) {
680: if (i>=P) PetscCall(VecSetValue(vomega,i,-1.0,INSERT_VALUES));
681: }
682: PetscCall(VecAssemblyBegin(vomega));
683: PetscCall(VecAssemblyEnd(vomega));
685: PetscCall(MatGetType(A,&Atype));
686: PetscCall(MatCreate(PETSC_COMM_WORLD,&Omega));
687: PetscCall(MatSetSizes(Omega,PETSC_DECIDE,PETSC_DECIDE,P+Q,P+Q));
688: PetscCall(MatSetType(Omega,Atype));
689: PetscCall(MatDiagonalSet(Omega,vomega,INSERT_VALUES));
691: /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
692: Create the singular value solver and set various options
693: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
695: PetscCall(SVDCreate(PETSC_COMM_WORLD,&svd));
697: PetscCall(SVDSetOperators(svd,A,NULL));
698: PetscCall(SVDSetSignature(svd,vomega));
699: PetscCall(SVDSetProblemType(svd,SVD_HYPERBOLIC));
701: PetscCall(SVDSetFromOptions(svd));
703: /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
704: Solve the problem, display solution
705: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
707: PetscCall(MatCreateVecs(A,&v,&u));
708: PetscCall(SVDSolve(svd));
710: /* show detailed info unless -terse option is given by user */
711: PetscCall(PetscOptionsHasName(NULL,NULL,"-terse",&terse));
712: if (terse) PetscCall(SVDErrorView(svd,SVD_ERROR_NORM,NULL));
713: else {
714: PetscCall(PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_INFO_DETAIL));
715: PetscCall(SVDConvergedReasonView(svd,PETSC_VIEWER_STDOUT_WORLD));
716: PetscCall(SVDErrorView(svd,SVD_ERROR_NORM,PETSC_VIEWER_STDOUT_WORLD));
717: PetscCall(PetscViewerPopFormat(PETSC_VIEWER_STDOUT_WORLD));
718: }
720: /* check orthogonality */
721: PetscCall(PetscOptionsGetBool(NULL,NULL,"-skiporth",&skiporth,NULL));
722: PetscCall(SVDGetConverged(svd,&nconv));
723: PetscCall(SVDGetDimensions(svd,&nsv,NULL,NULL));
724: nconv = PetscMin(nconv,nsv);
725: if (nconv>0 && !skiporth) {
726: PetscCall(SVDGetTolerances(svd,&tol,NULL));
727: PetscCall(VecDuplicateVecs(u,nconv,&U));
728: PetscCall(VecDuplicateVecs(v,nconv,&V));
729: for (i=0;i<nconv;i++) PetscCall(SVDGetSingularTriplet(svd,i,NULL,U[i],V[i]));
730: PetscCall(VecCheckOrthonormality(U,nconv,NULL,nconv,Omega,NULL,&lev1));
731: PetscCall(VecCheckOrthonormality(V,nconv,NULL,nconv,NULL,NULL,&lev2));
732: if (lev1+lev2<20*tol) PetscCall(PetscPrintf(PETSC_COMM_WORLD,"Level of orthogonality below the tolerance\n"));
733: else PetscCall(PetscPrintf(PETSC_COMM_WORLD,"Level of orthogonality: %g (U) %g (V)\n",(double)lev1,(double)lev2));
734: PetscCall(VecDestroyVecs(nconv,&U));
735: PetscCall(VecDestroyVecs(nconv,&V));
736: }
737: PetscCall(VecDestroy(&u));
738: PetscCall(VecDestroy(&v));
740: /* free work space */
741: PetscCall(SVDDestroy(&svd));
742: PetscCall(MatDestroy(&Omega));
743: PetscCall(MatDestroy(&A));
744: PetscCall(VecDestroy(&vomega));
745: PetscCall(SlepcFinalize());
746: return 0;
747: }
749: /*TEST
751: testset:
752: args: -svd_nsv 5 -d .15 -terse
753: output_file: output/ex53_1.out
754: nsize: {{1 2}}
755: test:
756: args: -svd_type trlanczos -ds_parallel {{redundant synchronized}}
757: suffix: 1_trlanczos
758: test:
759: args: -svd_type cross
760: suffix: 1_cross
761: test:
762: args: -svd_type cyclic
763: requires: !single
764: suffix: 1_cyclic
766: TEST*/