xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 70022509d1c65f3f7cbed7e48cb9cb7fb9aa7ea1)
1ab5c6b0cSJed Brown #include <../src/ksp/pc/impls/bddc/bddc.h>
2ab5c6b0cSJed Brown #include <../src/ksp/pc/impls/bddc/bddcprivate.h>
3674ae819SStefano Zampini #include <petscblaslapack.h>
4674ae819SStefano Zampini 
5906d46d4SStefano Zampini static PetscErrorCode PCBDDCMatMultTranspose_Private(Mat A, Vec x, Vec y);
6906d46d4SStefano Zampini static PetscErrorCode PCBDDCMatMult_Private(Mat A, Vec x, Vec y);
7906d46d4SStefano Zampini 
8b1b3d7a2SStefano Zampini #undef __FUNCT__
9b1b3d7a2SStefano Zampini #define __FUNCT__ "PCBDDCAdaptiveSelection"
1008122e43SStefano Zampini PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
11b1b3d7a2SStefano Zampini {
12b1b3d7a2SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
1308122e43SStefano Zampini   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
1408122e43SStefano Zampini   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
1508122e43SStefano Zampini   PetscBLASInt    *B_iwork,*B_ifail;
1608122e43SStefano Zampini   PetscScalar     *work,lwork;
1708122e43SStefano Zampini   PetscScalar     *St,*S,*eigv;
1808122e43SStefano Zampini   PetscScalar     *Sarray,*Starray;
1908122e43SStefano Zampini   PetscReal       *eigs,thresh;
201b968477SStefano Zampini   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
21f6f667cfSStefano Zampini   PetscBool       allocated_S_St;
2208122e43SStefano Zampini #if defined(PETSC_USE_COMPLEX)
2308122e43SStefano Zampini   PetscReal       *rwork;
2408122e43SStefano Zampini #endif
25b1b3d7a2SStefano Zampini   PetscErrorCode  ierr;
26b1b3d7a2SStefano Zampini 
27b1b3d7a2SStefano Zampini   PetscFunctionBegin;
2808122e43SStefano Zampini   if (!sub_schurs->use_mumps) {
2908122e43SStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS");
3008122e43SStefano Zampini   }
3108122e43SStefano Zampini 
32fd14bc51SStefano Zampini   if (pcbddc->dbg_flag) {
33fd14bc51SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
34fd14bc51SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
35fd14bc51SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
36fd14bc51SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
37fd14bc51SStefano Zampini   }
38fd14bc51SStefano Zampini 
39e496cd5dSStefano Zampini   if (pcbddc->dbg_flag) {
40e496cd5dSStefano Zampini     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %d (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);
41e496cd5dSStefano Zampini   }
42e496cd5dSStefano Zampini 
43e496cd5dSStefano Zampini   if (sub_schurs->n_subs && (!sub_schurs->is_hermitian || !sub_schurs->is_posdef)) {
44e496cd5dSStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Adaptive selection not yet implemented for general matrix pencils (herm %d, posdef %d)\n",sub_schurs->is_hermitian,sub_schurs->is_posdef);
45e496cd5dSStefano Zampini   }
46e496cd5dSStefano Zampini 
4708122e43SStefano Zampini   /* max size of subsets */
4808122e43SStefano Zampini   mss = 0;
4908122e43SStefano Zampini   for (i=0;i<sub_schurs->n_subs;i++) {
5008122e43SStefano Zampini     if (PetscBTLookup(sub_schurs->computed_Stilda_subs,i)) {
5108122e43SStefano Zampini       PetscInt subset_size;
5208122e43SStefano Zampini       ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
5308122e43SStefano Zampini       mss = PetscMax(mss,subset_size);
5408122e43SStefano Zampini     }
5508122e43SStefano Zampini   }
5608122e43SStefano Zampini 
5708122e43SStefano Zampini   /* min/max and threshold */
5808122e43SStefano Zampini   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
59f6f667cfSStefano Zampini   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
6008122e43SStefano Zampini   nmax = PetscMax(nmin,nmax);
61f6f667cfSStefano Zampini   allocated_S_St = PETSC_FALSE;
62f6f667cfSStefano Zampini   if (nmin) {
63f6f667cfSStefano Zampini     allocated_S_St = PETSC_TRUE;
64f6f667cfSStefano Zampini   }
6508122e43SStefano Zampini 
6608122e43SStefano Zampini   /* allocate lapack workspace */
6708122e43SStefano Zampini   cum = cum2 = 0;
6808122e43SStefano Zampini   maxneigs = 0;
6908122e43SStefano Zampini   for (i=0;i<sub_schurs->n_subs;i++) {
7008122e43SStefano Zampini     if (PetscBTLookup(sub_schurs->computed_Stilda_subs,i)) {
7108122e43SStefano Zampini       PetscInt n,subset_size;
72f6f667cfSStefano Zampini 
7308122e43SStefano Zampini       ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
7408122e43SStefano Zampini       n = PetscMin(subset_size,nmax);
7508122e43SStefano Zampini       cum += subset_size*n;
7608122e43SStefano Zampini       cum2 += n;
7708122e43SStefano Zampini       maxneigs = PetscMax(maxneigs,n);
7808122e43SStefano Zampini     }
7908122e43SStefano Zampini   }
8008122e43SStefano Zampini   if (mss) {
819ab7bb16SStefano Zampini     if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
8208122e43SStefano Zampini       PetscBLASInt B_itype = 1;
8308122e43SStefano Zampini       PetscBLASInt B_N = mss;
844c6709b3SStefano Zampini       PetscReal    zero = 0.0;
854c6709b3SStefano Zampini       PetscReal    eps = 0.0; /* dlamch? */
8608122e43SStefano Zampini 
8708122e43SStefano Zampini       B_lwork = -1;
8808122e43SStefano Zampini       S = NULL;
8908122e43SStefano Zampini       St = NULL;
90a58a30b4SStefano Zampini       eigs = NULL;
91a58a30b4SStefano Zampini       eigv = NULL;
92a58a30b4SStefano Zampini       B_iwork = NULL;
93a58a30b4SStefano Zampini       B_ifail = NULL;
948bec7fa6SStefano Zampini       thresh = 1.0;
9508122e43SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
9608122e43SStefano Zampini #if defined(PETSC_USE_COMPLEX)
9708122e43SStefano Zampini       PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
9808122e43SStefano Zampini #else
9908122e43SStefano Zampini       PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,B_iwork,B_ifail,&B_ierr));
10008122e43SStefano Zampini #endif
10108122e43SStefano Zampini       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
10208122e43SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
10308122e43SStefano Zampini     } else {
10408122e43SStefano Zampini         /* TODO */
10508122e43SStefano Zampini     }
10608122e43SStefano Zampini   } else {
10708122e43SStefano Zampini     lwork = 0;
10808122e43SStefano Zampini   }
10908122e43SStefano Zampini 
11008122e43SStefano Zampini   nv = 0;
1118bec7fa6SStefano Zampini   if (sub_schurs->is_Ej_com && pcbddc->use_vertices) { /* complement of subsets, each entry is a vertex */
11208122e43SStefano Zampini     ierr = ISGetLocalSize(sub_schurs->is_Ej_com,&nv);CHKERRQ(ierr);
11308122e43SStefano Zampini   }
1144c6709b3SStefano Zampini   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
115f6f667cfSStefano Zampini   if (allocated_S_St) {
116f6f667cfSStefano Zampini     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
117f6f667cfSStefano Zampini   }
118f6f667cfSStefano Zampini   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
11908122e43SStefano Zampini #if defined(PETSC_USE_COMPLEX)
12008122e43SStefano Zampini   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
12108122e43SStefano Zampini #endif
12208122e43SStefano Zampini   ierr = PetscMalloc4(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
12308122e43SStefano Zampini                       nv+cum2+1,&pcbddc->adaptive_constraints_ptrs,
12408122e43SStefano Zampini                       nv+cum,&pcbddc->adaptive_constraints_idxs,
12508122e43SStefano Zampini                       nv+cum,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
12608122e43SStefano Zampini   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
12708122e43SStefano Zampini 
12808122e43SStefano Zampini   maxneigs = 0;
12908122e43SStefano Zampini   cum = cum2 = cumarray = 0;
1308bec7fa6SStefano Zampini   if (sub_schurs->is_Ej_com && pcbddc->use_vertices) {
13108122e43SStefano Zampini     const PetscInt *idxs;
13208122e43SStefano Zampini 
13308122e43SStefano Zampini     ierr = ISGetIndices(sub_schurs->is_Ej_com,&idxs);CHKERRQ(ierr);
13408122e43SStefano Zampini     for (cum=0;cum<nv;cum++) {
13508122e43SStefano Zampini       pcbddc->adaptive_constraints_n[cum] = 1;
13608122e43SStefano Zampini       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
13708122e43SStefano Zampini       pcbddc->adaptive_constraints_ptrs[cum] = cum;
13808122e43SStefano Zampini       pcbddc->adaptive_constraints_data[cum] = 1.0;
13908122e43SStefano Zampini     }
14008122e43SStefano Zampini     cum2 = cum;
14108122e43SStefano Zampini     ierr = ISRestoreIndices(sub_schurs->is_Ej_com,&idxs);CHKERRQ(ierr);
14208122e43SStefano Zampini   }
14308122e43SStefano Zampini 
14408122e43SStefano Zampini   if (mss) { /* multilevel */
14508122e43SStefano Zampini     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
14608122e43SStefano Zampini     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
14708122e43SStefano Zampini   }
14808122e43SStefano Zampini 
14908122e43SStefano Zampini   for (i=0;i<sub_schurs->n_subs;i++) {
15008122e43SStefano Zampini     PetscInt j,subset_size;
15108122e43SStefano Zampini 
15208122e43SStefano Zampini     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
15308122e43SStefano Zampini     if (PetscBTLookup(sub_schurs->computed_Stilda_subs,i)) {
15408122e43SStefano Zampini       const PetscInt *idxs;
155f6f667cfSStefano Zampini       PetscReal      infty = PETSC_MAX_REAL;
156f6f667cfSStefano Zampini       PetscInt       eigs_start = 0;
15708122e43SStefano Zampini       PetscBLASInt   B_N;
15808122e43SStefano Zampini 
159f6f667cfSStefano Zampini       ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
160f6f667cfSStefano Zampini       if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
1619ab7bb16SStefano Zampini         if (sub_schurs->is_hermitian) {
16208122e43SStefano Zampini           PetscInt j;
16308122e43SStefano Zampini           for (j=0;j<subset_size;j++) {
16408122e43SStefano Zampini             ierr = PetscMemcpy(S+j*(subset_size+1),Sarray+cumarray+j*(subset_size+1),(subset_size-j)*sizeof(PetscScalar));CHKERRQ(ierr);
16508122e43SStefano Zampini           }
16608122e43SStefano Zampini           for (j=0;j<subset_size;j++) {
16708122e43SStefano Zampini             ierr = PetscMemcpy(St+j*(subset_size+1),Starray+cumarray+j*(subset_size+1),(subset_size-j)*sizeof(PetscScalar));CHKERRQ(ierr);
16808122e43SStefano Zampini           }
16908122e43SStefano Zampini         } else {
17008122e43SStefano Zampini           ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
17108122e43SStefano Zampini           ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
17208122e43SStefano Zampini         }
1738bec7fa6SStefano Zampini       } else {
174f6f667cfSStefano Zampini         S = Sarray + cumarray;
175f6f667cfSStefano Zampini         St = Starray + cumarray;
1768bec7fa6SStefano Zampini       }
17708122e43SStefano Zampini 
178f6f667cfSStefano Zampini       /* Threshold: this is an heuristic for edges */
179f6f667cfSStefano Zampini       ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
180f6f667cfSStefano Zampini       thresh = pcbddc->mat_graph->count[idxs[0]]*pcbddc->adaptive_threshold;
181f6f667cfSStefano Zampini 
1829ab7bb16SStefano Zampini       if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
18308122e43SStefano Zampini         PetscBLASInt B_itype = 1;
184f6f667cfSStefano Zampini         PetscBLASInt B_IL, B_IU;
1854c6709b3SStefano Zampini         PetscReal    eps = -1.0; /* dlamch? */
1869552c7c7SStefano Zampini         PetscInt     nmin_s;
18708122e43SStefano Zampini 
188f6f667cfSStefano Zampini         /* ask for eigenvalues larger than thresh */
189fd14bc51SStefano Zampini         if (pcbddc->dbg_flag) {
1908bec7fa6SStefano Zampini           PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %d/%d %d %d.\n",i,sub_schurs->n_subs,subset_size,pcbddc->mat_graph->count[idxs[0]]);
191fd14bc51SStefano Zampini         }
19208122e43SStefano Zampini         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
19308122e43SStefano Zampini #if defined(PETSC_USE_COMPLEX)
194f6f667cfSStefano Zampini         PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&thresh,&infty,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
19508122e43SStefano Zampini #else
196f6f667cfSStefano Zampini         PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&thresh,&infty,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
19708122e43SStefano Zampini #endif
19808122e43SStefano Zampini         ierr = PetscFPTrapPop();CHKERRQ(ierr);
19908122e43SStefano Zampini         if (B_ierr) {
20008122e43SStefano Zampini           if (B_ierr < 0 ) {
20108122e43SStefano Zampini             SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
20208122e43SStefano Zampini           } else if (B_ierr <= B_N) {
20308122e43SStefano Zampini             SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr);
20408122e43SStefano Zampini           } else {
2059552c7c7SStefano Zampini             SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %d is not positive definite",(int)B_ierr-B_N-1);
20608122e43SStefano Zampini           }
20708122e43SStefano Zampini         }
20808122e43SStefano Zampini 
20908122e43SStefano Zampini         if (B_neigs > nmax) {
210fd14bc51SStefano Zampini           if (pcbddc->dbg_flag) {
211fd14bc51SStefano Zampini             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %d.\n",B_neigs,nmax);
212fd14bc51SStefano Zampini           }
213f6f667cfSStefano Zampini           eigs_start = B_neigs -nmax;
21408122e43SStefano Zampini           B_neigs = nmax;
21508122e43SStefano Zampini         }
21608122e43SStefano Zampini 
2179552c7c7SStefano Zampini         nmin_s = PetscMin(nmin,B_N);
2189552c7c7SStefano Zampini         if (B_neigs < nmin_s) {
21908122e43SStefano Zampini           PetscBLASInt B_neigs2;
22008122e43SStefano Zampini 
221f6f667cfSStefano Zampini           B_IU = B_N - B_neigs;
222f6f667cfSStefano Zampini           B_IL = B_N - nmin_s + 1;
223fd14bc51SStefano Zampini           if (pcbddc->dbg_flag) {
224fd14bc51SStefano Zampini             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, less than minimum required %d. Asking for %d to %d incl (fortran like)\n",B_neigs,nmin,B_IL,B_IU);
225fd14bc51SStefano Zampini           }
2269ab7bb16SStefano Zampini           if (sub_schurs->is_hermitian) {
22708122e43SStefano Zampini             PetscInt j;
22808122e43SStefano Zampini             for (j=0;j<subset_size;j++) {
22908122e43SStefano Zampini               ierr = PetscMemcpy(S+j*(subset_size+1),Sarray+cumarray+j*(subset_size+1),(subset_size-j)*sizeof(PetscScalar));CHKERRQ(ierr);
23008122e43SStefano Zampini             }
23108122e43SStefano Zampini             for (j=0;j<subset_size;j++) {
23208122e43SStefano Zampini               ierr = PetscMemcpy(St+j*(subset_size+1),Starray+cumarray+j*(subset_size+1),(subset_size-j)*sizeof(PetscScalar));CHKERRQ(ierr);
23308122e43SStefano Zampini             }
23408122e43SStefano Zampini           } else {
23508122e43SStefano Zampini             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
23608122e43SStefano Zampini             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
23708122e43SStefano Zampini           }
23808122e43SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
23908122e43SStefano Zampini #if defined(PETSC_USE_COMPLEX)
240f6f667cfSStefano Zampini           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&thresh,&infty,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*subset_size,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
24108122e43SStefano Zampini #else
242f6f667cfSStefano Zampini           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&thresh,&infty,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*subset_size,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
24308122e43SStefano Zampini #endif
24408122e43SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
24508122e43SStefano Zampini           B_neigs += B_neigs2;
24608122e43SStefano Zampini         }
24708122e43SStefano Zampini         if (B_ierr) {
24808122e43SStefano Zampini           if (B_ierr < 0 ) {
24908122e43SStefano Zampini             SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
25008122e43SStefano Zampini           } else if (B_ierr <= B_N) {
25108122e43SStefano Zampini             SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr);
25208122e43SStefano Zampini           } else {
2539552c7c7SStefano Zampini             SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %d is not positive definite",(int)B_ierr-B_N-1);
25408122e43SStefano Zampini           }
25508122e43SStefano Zampini         }
256fd14bc51SStefano Zampini         if (pcbddc->dbg_flag) {
257fd14bc51SStefano Zampini           PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);
25808122e43SStefano Zampini           for (j=0;j<B_neigs;j++) {
25908122e43SStefano Zampini             if (eigs[j] == 0.0) {
260fd14bc51SStefano Zampini               PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");
26108122e43SStefano Zampini             } else {
262f6f667cfSStefano Zampini               PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);
263fd14bc51SStefano Zampini             }
26408122e43SStefano Zampini           }
26508122e43SStefano Zampini         }
26608122e43SStefano Zampini       } else {
26708122e43SStefano Zampini           /* TODO */
26808122e43SStefano Zampini       }
26908122e43SStefano Zampini 
2708bec7fa6SStefano Zampini       maxneigs = PetscMax(B_neigs,maxneigs);
2718bec7fa6SStefano Zampini       pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
272f6f667cfSStefano Zampini       ierr = PetscMemcpy(pcbddc->adaptive_constraints_data+cum2,eigv+eigs_start*subset_size,B_neigs*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
273fd14bc51SStefano Zampini 
274fd14bc51SStefano Zampini       if (pcbddc->dbg_flag > 1) {
2759552c7c7SStefano Zampini         PetscInt ii;
2769552c7c7SStefano Zampini         for (ii=0;ii<B_neigs;ii++) {
277fd14bc51SStefano Zampini           PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);
2789552c7c7SStefano Zampini           for (j=0;j<B_N;j++) {
279f6f667cfSStefano Zampini             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+cum2]);
2809552c7c7SStefano Zampini           }
2819552c7c7SStefano Zampini         }
282fd14bc51SStefano Zampini       }
28308122e43SStefano Zampini       for (j=0;j<B_neigs;j++) {
28408122e43SStefano Zampini #if 0
28508122e43SStefano Zampini         {
28608122e43SStefano Zampini           PetscBLASInt Blas_N,Blas_one = 1.0;
28708122e43SStefano Zampini           PetscScalar norm;
28808122e43SStefano Zampini           ierr = PetscBLASIntCast(subset_size,&Blas_N);CHKERRQ(ierr);
28908122e43SStefano Zampini           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,pcbddc->adaptive_constraints_data+cum2,&Blas_one,pcbddc->adaptive_constraints_data+cum2,&Blas_one));
29008122e43SStefano Zampini           if (pcbddc->adaptive_constraints_data[cum2] > 0.0) {
29108122e43SStefano Zampini             norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
29208122e43SStefano Zampini           } else {
29308122e43SStefano Zampini             norm = -1.0/PetscSqrtReal(PetscRealPart(norm));
29408122e43SStefano Zampini           }
29508122e43SStefano Zampini           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,pcbddc->adaptive_constraints_data+cum2,&Blas_one));
296b1b3d7a2SStefano Zampini         }
297b1b3d7a2SStefano Zampini #endif
29808122e43SStefano Zampini         ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+cum2,idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
29908122e43SStefano Zampini         pcbddc->adaptive_constraints_ptrs[cum++] = cum2;
30008122e43SStefano Zampini         cum2 += subset_size;
30108122e43SStefano Zampini       }
30208122e43SStefano Zampini       ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
30308122e43SStefano Zampini     }
30408122e43SStefano Zampini     /* shift for next computation */
30508122e43SStefano Zampini     cumarray += subset_size*subset_size;
30608122e43SStefano Zampini   }
307fd14bc51SStefano Zampini   if (pcbddc->dbg_flag) {
308fd14bc51SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
309fd14bc51SStefano Zampini   }
31008122e43SStefano Zampini   pcbddc->adaptive_constraints_ptrs[cum] = cum2;
31108122e43SStefano Zampini 
31208122e43SStefano Zampini   if (mss) {
31308122e43SStefano Zampini     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
31408122e43SStefano Zampini     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
315f6f667cfSStefano Zampini     /* destroy matrices (junk) */
316f6f667cfSStefano Zampini     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
317f6f667cfSStefano Zampini     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
31808122e43SStefano Zampini   }
319f6f667cfSStefano Zampini   if (allocated_S_St) {
320f6f667cfSStefano Zampini     ierr = PetscFree2(S,St);CHKERRQ(ierr);
321f6f667cfSStefano Zampini   }
322f6f667cfSStefano Zampini   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
32308122e43SStefano Zampini #if defined(PETSC_USE_COMPLEX)
32408122e43SStefano Zampini   ierr = PetscFree(rwork);CHKERRQ(ierr);
32508122e43SStefano Zampini #endif
32608122e43SStefano Zampini   if (pcbddc->dbg_flag) {
3271b968477SStefano Zampini     PetscInt maxneigs_r;
32808122e43SStefano Zampini     ierr = MPI_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3299b28b941SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %d\n",maxneigs_r);CHKERRQ(ierr);
33008122e43SStefano Zampini   }
33108122e43SStefano Zampini   PetscFunctionReturn(0);
33208122e43SStefano Zampini }
333b1b3d7a2SStefano Zampini 
334674ae819SStefano Zampini #undef __FUNCT__
335c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpSolvers"
336c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpSolvers(PC pc)
337c8587f34SStefano Zampini {
338c8587f34SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3398629588bSStefano Zampini   PetscScalar    *coarse_submat_vals;
340c8587f34SStefano Zampini   PetscErrorCode ierr;
341c8587f34SStefano Zampini 
342c8587f34SStefano Zampini   PetscFunctionBegin;
343f4ddd8eeSStefano Zampini   /* Setup local scatters R_to_B and (optionally) R_to_D */
3445e8657edSStefano Zampini   /* PCBDDCSetUpLocalWorkVectors should be called first! */
345c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
346c8587f34SStefano Zampini 
347684f6988SStefano Zampini   /* Setup local neumann solver ksp_R */
3480fccc4e9SStefano Zampini   /* PCBDDCSetUpLocalScatters should be called first! */
349684f6988SStefano Zampini   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
350c8587f34SStefano Zampini 
351c8587f34SStefano Zampini   /* Change global null space passed in by the user if change of basis has been requested */
352b9b85e73SStefano Zampini   if (pcbddc->NullSpace && pcbddc->ChangeOfBasisMatrix) {
353c8587f34SStefano Zampini     ierr = PCBDDCNullSpaceAdaptGlobal(pc);CHKERRQ(ierr);
354c8587f34SStefano Zampini   }
355c8587f34SStefano Zampini 
3568629588bSStefano Zampini   /*
3578629588bSStefano Zampini      Setup local correction and local part of coarse basis.
3588629588bSStefano Zampini      Gives back the dense local part of the coarse matrix in column major ordering
3598629588bSStefano Zampini   */
36047f4ddc3SStefano Zampini   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3618629588bSStefano Zampini 
3628629588bSStefano Zampini   /* Compute total number of coarse nodes and setup coarse solver */
3638629588bSStefano Zampini   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3648629588bSStefano Zampini 
3658629588bSStefano Zampini   /* free */
3668629588bSStefano Zampini   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
367c8587f34SStefano Zampini   PetscFunctionReturn(0);
368c8587f34SStefano Zampini }
369c8587f34SStefano Zampini 
370c8587f34SStefano Zampini #undef __FUNCT__
371674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetCustomization"
372674ae819SStefano Zampini PetscErrorCode PCBDDCResetCustomization(PC pc)
373674ae819SStefano Zampini {
374674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
375674ae819SStefano Zampini   PetscErrorCode ierr;
376674ae819SStefano Zampini 
377674ae819SStefano Zampini   PetscFunctionBegin;
378674ae819SStefano Zampini   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
379674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
380674ae819SStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->NullSpace);CHKERRQ(ierr);
381674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
382785d1243SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
383674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
384f4ddd8eeSStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
385f4ddd8eeSStefano Zampini   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
386785d1243SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
38763602bcaSStefano Zampini   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
38863602bcaSStefano Zampini   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
389674ae819SStefano Zampini   PetscFunctionReturn(0);
390674ae819SStefano Zampini }
391674ae819SStefano Zampini 
392674ae819SStefano Zampini #undef __FUNCT__
393674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetTopography"
394674ae819SStefano Zampini PetscErrorCode PCBDDCResetTopography(PC pc)
395674ae819SStefano Zampini {
396674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
397674ae819SStefano Zampini   PetscErrorCode ierr;
398674ae819SStefano Zampini 
399674ae819SStefano Zampini   PetscFunctionBegin;
400b9b85e73SStefano Zampini   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
401674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
402674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
403674ae819SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
404b96c3477SStefano Zampini   ierr = PCBDDCSubSchursReset(pcbddc->sub_schurs);CHKERRQ(ierr);
405674ae819SStefano Zampini   PetscFunctionReturn(0);
406674ae819SStefano Zampini }
407674ae819SStefano Zampini 
408674ae819SStefano Zampini #undef __FUNCT__
409674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetSolvers"
410674ae819SStefano Zampini PetscErrorCode PCBDDCResetSolvers(PC pc)
411674ae819SStefano Zampini {
412674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
41306656605SStefano Zampini   PetscScalar    *array;
414674ae819SStefano Zampini   PetscErrorCode ierr;
415674ae819SStefano Zampini 
416674ae819SStefano Zampini   PetscFunctionBegin;
417674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
41858da7f69SStefano Zampini   if (pcbddc->coarse_phi_B) {
41906656605SStefano Zampini     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
42006656605SStefano Zampini     ierr = PetscFree(array);CHKERRQ(ierr);
42158da7f69SStefano Zampini   }
422674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
423674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
42415aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
42515aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
426674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
427674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
42806656605SStefano Zampini   if (pcbddc->local_auxmat2) {
42906656605SStefano Zampini     ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
43006656605SStefano Zampini     ierr = PetscFree(array);CHKERRQ(ierr);
43106656605SStefano Zampini   }
432674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
43306656605SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
434674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
435674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
4368ce42a96SStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
437674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
438674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
439674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
440f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->ksp_D);CHKERRQ(ierr);
441f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->ksp_R);CHKERRQ(ierr);
442f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
443f4ddd8eeSStefano Zampini   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
444727cdba6SStefano Zampini   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
445f4ddd8eeSStefano Zampini   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
44670cf5478SStefano Zampini   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
4476e683305SStefano Zampini   ierr = ISDestroy(&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
448674ae819SStefano Zampini   PetscFunctionReturn(0);
449674ae819SStefano Zampini }
450674ae819SStefano Zampini 
451674ae819SStefano Zampini #undef __FUNCT__
452f4ddd8eeSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalWorkVectors"
453f4ddd8eeSStefano Zampini PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
4546bfb1811SStefano Zampini {
4556bfb1811SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
4566bfb1811SStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
4576bfb1811SStefano Zampini   VecType        impVecType;
458e9189074SStefano Zampini   PetscInt       n_constraints,n_R,old_size;
4596bfb1811SStefano Zampini   PetscErrorCode ierr;
4606bfb1811SStefano Zampini 
4616bfb1811SStefano Zampini   PetscFunctionBegin;
462f4ddd8eeSStefano Zampini   if (!pcbddc->ConstraintMatrix) {
463f4ddd8eeSStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Constraint matrix has not been created");
464f4ddd8eeSStefano Zampini   }
465e7b262bdSStefano Zampini   /* get sizes */
466e9189074SStefano Zampini   n_constraints = pcbddc->local_primal_size - pcbddc->n_actual_vertices;
467e9189074SStefano Zampini   n_R = pcis->n-pcbddc->n_actual_vertices;
4686bfb1811SStefano Zampini   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
469e7b262bdSStefano Zampini   /* local work vectors (try to avoid unneeded work)*/
470e7b262bdSStefano Zampini   /* R nodes */
471e7b262bdSStefano Zampini   old_size = -1;
472e7b262bdSStefano Zampini   if (pcbddc->vec1_R) {
473e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
474e7b262bdSStefano Zampini   }
475e7b262bdSStefano Zampini   if (n_R != old_size) {
476e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
477e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
4786bfb1811SStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
4796bfb1811SStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
4806bfb1811SStefano Zampini     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
4816bfb1811SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
482e7b262bdSStefano Zampini   }
483e7b262bdSStefano Zampini   /* local primal dofs */
484e7b262bdSStefano Zampini   old_size = -1;
485e7b262bdSStefano Zampini   if (pcbddc->vec1_P) {
486e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
487e7b262bdSStefano Zampini   }
488e9189074SStefano Zampini   if (pcbddc->local_primal_size != old_size) {
489e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
49083b7ccabSStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
491e9189074SStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
4926bfb1811SStefano Zampini     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
493e7b262bdSStefano Zampini   }
494e7b262bdSStefano Zampini   /* local explicit constraints */
495e7b262bdSStefano Zampini   old_size = -1;
496e7b262bdSStefano Zampini   if (pcbddc->vec1_C) {
497e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
498e7b262bdSStefano Zampini   }
499e7b262bdSStefano Zampini   if (n_constraints && n_constraints != old_size) {
500e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
50183b7ccabSStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
50283b7ccabSStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
50383b7ccabSStefano Zampini     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
50483b7ccabSStefano Zampini   }
5056bfb1811SStefano Zampini   PetscFunctionReturn(0);
5066bfb1811SStefano Zampini }
5076bfb1811SStefano Zampini 
5086bfb1811SStefano Zampini #undef __FUNCT__
50947f4ddc3SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCorrection"
51047f4ddc3SStefano Zampini PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
51188ebb749SStefano Zampini {
51225084f0cSStefano Zampini   PetscErrorCode         ierr;
51325084f0cSStefano Zampini   /* pointers to pcis and pcbddc */
51488ebb749SStefano Zampini   PC_IS*                 pcis = (PC_IS*)pc->data;
51588ebb749SStefano Zampini   PC_BDDC*               pcbddc = (PC_BDDC*)pc->data;
51625084f0cSStefano Zampini   /* submatrices of local problem */
51788ebb749SStefano Zampini   Mat                    A_RV,A_VR,A_VV;
51806656605SStefano Zampini   /* submatrices of local coarse problem */
51906656605SStefano Zampini   Mat                    S_VV,S_CV,S_VC,S_CC;
52025084f0cSStefano Zampini   /* working matrices */
52106656605SStefano Zampini   Mat                    C_CR;
52225084f0cSStefano Zampini   /* additional working stuff */
52306656605SStefano Zampini   PC                     pc_R;
52406656605SStefano Zampini   Mat                    F;
52506656605SStefano Zampini   PetscBool              isLU,isCHOL,isILU;
52606656605SStefano Zampini 
52725084f0cSStefano Zampini   PetscScalar            *coarse_submat_vals; /* TODO: use a PETSc matrix */
52806656605SStefano Zampini   PetscScalar            *work;
52906656605SStefano Zampini   PetscInt               *idx_V_B;
53006656605SStefano Zampini   PetscInt               n,n_vertices,n_constraints;
53106656605SStefano Zampini   PetscInt               i,n_R,n_D,n_B;
532b9d89cd5SStefano Zampini   PetscBool              unsymmetric_check;
53345a1bb75SStefano Zampini   /* matrix type (vector type propagated downstream from vec1_C and local matrix type) */
53488ebb749SStefano Zampini   MatType                impMatType;
53525084f0cSStefano Zampini   /* some shortcuts to scalars */
53606656605SStefano Zampini   PetscScalar            one=1.0,m_one=-1.0;
53788ebb749SStefano Zampini 
53888ebb749SStefano Zampini   PetscFunctionBegin;
539e9189074SStefano Zampini   /* get number of vertices (corners plus constraints with change of basis)
540e9189074SStefano Zampini      pcbddc->n_actual_vertices stores the actual number of vertices, pcbddc->n_vertices the number of corners computed */
541e9189074SStefano Zampini   n_vertices = pcbddc->n_actual_vertices;
54288ebb749SStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
54388ebb749SStefano Zampini   /* Set Non-overlapping dimensions */
54488ebb749SStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
54588ebb749SStefano Zampini   n_R = pcis->n-n_vertices;
54688ebb749SStefano Zampini 
54788ebb749SStefano Zampini   /* Set types for local objects needed by BDDC precondtioner */
54888ebb749SStefano Zampini   impMatType = MATSEQDENSE;
54988ebb749SStefano Zampini 
55088ebb749SStefano Zampini   /* vertices in boundary numbering */
551785e854fSJed Brown   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
5525e8657edSStefano Zampini   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->primal_indices_local_idxs,&i,idx_V_B);CHKERRQ(ierr);
55388ebb749SStefano Zampini   if (i != n_vertices) {
55422d5777bSStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %d != %d\n",n_vertices,i);
55588ebb749SStefano Zampini   }
55688ebb749SStefano Zampini 
55706656605SStefano Zampini   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
55806656605SStefano Zampini   ierr = PetscMalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
55906656605SStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
56006656605SStefano Zampini   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
56106656605SStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
56206656605SStefano Zampini   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
56306656605SStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
56406656605SStefano Zampini   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
56506656605SStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
56606656605SStefano Zampini   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
56706656605SStefano Zampini 
56806656605SStefano Zampini   unsymmetric_check = PETSC_FALSE;
56906656605SStefano Zampini   /* allocate workspace */
57006656605SStefano Zampini   n = 0;
57106656605SStefano Zampini   if (n_constraints) {
57206656605SStefano Zampini     n += n_R*n_constraints;
57306656605SStefano Zampini   }
57406656605SStefano Zampini   if (n_vertices) {
57506656605SStefano Zampini     n = PetscMax(2*n_R*n_vertices,n);
57606656605SStefano Zampini   }
57706656605SStefano Zampini   if (!pcbddc->issym) {
57806656605SStefano Zampini     n = PetscMax(2*n_R*pcbddc->local_primal_size,n);
57906656605SStefano Zampini     unsymmetric_check = PETSC_TRUE;
58006656605SStefano Zampini   }
58106656605SStefano Zampini   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
58206656605SStefano Zampini 
58306656605SStefano Zampini   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
58406656605SStefano Zampini   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
58506656605SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
58606656605SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
58706656605SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
58806656605SStefano Zampini   if (isLU || isILU || isCHOL) {
58906656605SStefano Zampini     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
59006656605SStefano Zampini   } else {
59106656605SStefano Zampini     F = NULL;
59206656605SStefano Zampini   }
59306656605SStefano Zampini 
59488ebb749SStefano Zampini   /* Precompute stuffs needed for preprocessing and application of BDDC*/
59588ebb749SStefano Zampini   if (n_constraints) {
59606656605SStefano Zampini     Mat M1,M2,M3;
59706656605SStefano Zampini     IS  is_aux;
598f4ddd8eeSStefano Zampini     /* see if we can save some allocations */
599f4ddd8eeSStefano Zampini     if (pcbddc->local_auxmat2) {
600f4ddd8eeSStefano Zampini       PetscInt on_R,on_constraints;
601f4ddd8eeSStefano Zampini       ierr = MatGetSize(pcbddc->local_auxmat2,&on_R,&on_constraints);CHKERRQ(ierr);
602f4ddd8eeSStefano Zampini       if (on_R != n_R || on_constraints != n_constraints) {
60306656605SStefano Zampini         PetscScalar *marray;
60406656605SStefano Zampini 
60506656605SStefano Zampini         ierr = MatDenseGetArray(pcbddc->local_auxmat2,&marray);CHKERRQ(ierr);
60606656605SStefano Zampini         ierr = PetscFree(marray);CHKERRQ(ierr);
607f4ddd8eeSStefano Zampini         ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
608f4ddd8eeSStefano Zampini         ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
609f4ddd8eeSStefano Zampini       }
610f4ddd8eeSStefano Zampini     }
61145a1bb75SStefano Zampini     /* auxiliary matrices */
612f4ddd8eeSStefano Zampini     if (!pcbddc->local_auxmat2) {
61306656605SStefano Zampini       PetscScalar *marray;
61406656605SStefano Zampini 
61506656605SStefano Zampini       ierr = PetscMalloc1(2*n_R*n_constraints,&marray);CHKERRQ(ierr);
61606656605SStefano Zampini       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,marray,&pcbddc->local_auxmat2);CHKERRQ(ierr);
61706656605SStefano Zampini       marray += n_R*n_constraints;
61806656605SStefano Zampini       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_R,marray,&pcbddc->local_auxmat1);CHKERRQ(ierr);
619f4ddd8eeSStefano Zampini     }
62088ebb749SStefano Zampini 
62125084f0cSStefano Zampini     /* Extract constraints on R nodes: C_{CR}  */
62225084f0cSStefano Zampini     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
6238ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
62425084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
62588ebb749SStefano Zampini 
62688ebb749SStefano Zampini     /* Assemble local_auxmat2 = - A_{RR}^{-1} C^T_{CR} needed by BDDC application */
62706656605SStefano Zampini     ierr = PetscMemzero(work,n_R*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
62888ebb749SStefano Zampini     for (i=0;i<n_constraints;i++) {
62906656605SStefano Zampini       const PetscScalar *row_cmat_values;
63006656605SStefano Zampini       const PetscInt    *row_cmat_indices;
63106656605SStefano Zampini       PetscInt          size_of_constraint,j;
63288ebb749SStefano Zampini 
63306656605SStefano Zampini       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
63406656605SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
63506656605SStefano Zampini         work[row_cmat_indices[j]+i*n_R] = -row_cmat_values[j];
63606656605SStefano Zampini       }
63706656605SStefano Zampini       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
63806656605SStefano Zampini     }
63906656605SStefano Zampini     if (F) {
64006656605SStefano Zampini       Mat B;
64106656605SStefano Zampini 
64206656605SStefano Zampini       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
64306656605SStefano Zampini       ierr = MatMatSolve(F,B,pcbddc->local_auxmat2);CHKERRQ(ierr);
64406656605SStefano Zampini       ierr = MatDestroy(&B);CHKERRQ(ierr);
64506656605SStefano Zampini     } else {
64606656605SStefano Zampini       PetscScalar *xarray;
64706656605SStefano Zampini       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&xarray);CHKERRQ(ierr);
64806656605SStefano Zampini       for (i=0;i<n_constraints;i++) {
64906656605SStefano Zampini         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
65006656605SStefano Zampini         ierr = VecPlaceArray(pcbddc->vec2_R,xarray+i*n_R);CHKERRQ(ierr);
65106656605SStefano Zampini         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
65206656605SStefano Zampini         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
65306656605SStefano Zampini         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
65406656605SStefano Zampini       }
65506656605SStefano Zampini       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&xarray);CHKERRQ(ierr);
65606656605SStefano Zampini     }
65706656605SStefano Zampini 
65806656605SStefano Zampini     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
65906656605SStefano Zampini     ierr = MatConvert(C_CR,impMatType,MAT_REUSE_MATRIX,&C_CR);CHKERRQ(ierr);
66025084f0cSStefano Zampini     ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
66106656605SStefano Zampini     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M1);CHKERRQ(ierr);
66206656605SStefano Zampini     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
66325084f0cSStefano Zampini     ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
66406656605SStefano Zampini     ierr = VecSet(pcbddc->vec1_C,m_one);CHKERRQ(ierr);
66506656605SStefano Zampini     ierr = MatDiagonalSet(M2,pcbddc->vec1_C,INSERT_VALUES);CHKERRQ(ierr);
66625084f0cSStefano Zampini     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
66725084f0cSStefano Zampini     ierr = MatDestroy(&M2);CHKERRQ(ierr);
66825084f0cSStefano Zampini     ierr = MatDestroy(&M3);CHKERRQ(ierr);
66906656605SStefano Zampini     /* Assemble local_auxmat1 = S_CC*C_{CR} needed by BDDC application in KSP and in preproc */
670f4ddd8eeSStefano Zampini     ierr = MatMatMult(M1,C_CR,MAT_REUSE_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
67106656605SStefano Zampini     ierr = MatCopy(M1,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
67206656605SStefano Zampini     ierr = MatDestroy(&M1);CHKERRQ(ierr);
67388ebb749SStefano Zampini   }
67488ebb749SStefano Zampini   /* Get submatrices from subdomain matrix */
67588ebb749SStefano Zampini   if (n_vertices) {
67606656605SStefano Zampini     Mat       newmat;
67706656605SStefano Zampini     IS        is_aux;
6783a50541eSStefano Zampini     PetscInt  ibs,mbs;
6793a50541eSStefano Zampini     PetscBool issbaij;
6803a50541eSStefano Zampini 
6813a50541eSStefano Zampini     ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
6829577ea80SStefano Zampini     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
6839577ea80SStefano Zampini     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
6843a50541eSStefano Zampini     if (ibs != mbs) { /* need to convert to SEQAIJ */
6859577ea80SStefano Zampini       ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
6869577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
6879577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
6889577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
6899577ea80SStefano Zampini       ierr = MatDestroy(&newmat);CHKERRQ(ierr);
6909577ea80SStefano Zampini     } else {
6913a50541eSStefano Zampini       /* this is safe */
6929577ea80SStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
6933a50541eSStefano Zampini       ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
6943a50541eSStefano Zampini       if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
6953a50541eSStefano Zampini         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
6963a50541eSStefano Zampini         ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
69706656605SStefano Zampini         ierr = MatTranspose(A_VR,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
6983a50541eSStefano Zampini         ierr = MatDestroy(&newmat);CHKERRQ(ierr);
69903af80d8SStefano Zampini         ierr = MatConvert(A_VV,MATSEQBAIJ,MAT_REUSE_MATRIX,&A_VV);CHKERRQ(ierr);
7003a50541eSStefano Zampini       } else {
7019577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
7029577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
7039577ea80SStefano Zampini       }
7043a50541eSStefano Zampini     }
70525084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
70688ebb749SStefano Zampini   }
70788ebb749SStefano Zampini 
70888ebb749SStefano Zampini   /* Matrix of coarse basis functions (local) */
709f4ddd8eeSStefano Zampini   if (pcbddc->coarse_phi_B) {
71006656605SStefano Zampini     PetscInt on_B,on_primal,on_D=n_D;
71106656605SStefano Zampini     if (pcbddc->coarse_phi_D) {
71206656605SStefano Zampini       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
71306656605SStefano Zampini     }
714f4ddd8eeSStefano Zampini     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
71506656605SStefano Zampini     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
71606656605SStefano Zampini       PetscScalar *marray;
71706656605SStefano Zampini 
71806656605SStefano Zampini       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
71906656605SStefano Zampini       ierr = PetscFree(marray);CHKERRQ(ierr);
720f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
721f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
722f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
723f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
724f4ddd8eeSStefano Zampini     }
725f4ddd8eeSStefano Zampini   }
72606656605SStefano Zampini 
727f4ddd8eeSStefano Zampini   if (!pcbddc->coarse_phi_B) {
72806656605SStefano Zampini     PetscScalar *marray;
72988ebb749SStefano Zampini 
73006656605SStefano Zampini     n = n_B*pcbddc->local_primal_size;
7318eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
73206656605SStefano Zampini       n += n_D*pcbddc->local_primal_size;
73388ebb749SStefano Zampini     }
734b9d89cd5SStefano Zampini     if (!pcbddc->issym) {
73506656605SStefano Zampini       n *= 2;
736f4ddd8eeSStefano Zampini     }
73706656605SStefano Zampini     ierr = PetscCalloc1(n,&marray);CHKERRQ(ierr);
73806656605SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marray,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
73906656605SStefano Zampini     n = n_B*pcbddc->local_primal_size;
74006656605SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
74106656605SStefano Zampini       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
74206656605SStefano Zampini       n += n_D*pcbddc->local_primal_size;
74388ebb749SStefano Zampini     }
74406656605SStefano Zampini     if (!pcbddc->issym) {
74506656605SStefano Zampini       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
7461b968477SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
74706656605SStefano Zampini         n = n_B*pcbddc->local_primal_size;
74806656605SStefano Zampini         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
74988ebb749SStefano Zampini       }
75088ebb749SStefano Zampini     } else {
751c0553b1fSStefano Zampini       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
752c0553b1fSStefano Zampini       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
7531b968477SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
754c0553b1fSStefano Zampini         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
755c0553b1fSStefano Zampini         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
756c0553b1fSStefano Zampini       }
75788ebb749SStefano Zampini     }
75806656605SStefano Zampini   }
75906656605SStefano Zampini   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
76006656605SStefano Zampini   /* vertices */
76106656605SStefano Zampini   if (n_vertices) {
76216f15bc4SStefano Zampini 
76316f15bc4SStefano Zampini     if (n_R) {
76406656605SStefano Zampini       Mat          A_RRmA_RV,S_VVt; /* S_VVt with LDA=N */
76506656605SStefano Zampini       PetscBLASInt B_N,B_one = 1;
76616f15bc4SStefano Zampini       PetscScalar  *x,*y;
76706656605SStefano Zampini 
76806656605SStefano Zampini       ierr = PetscMemzero(work,2*n_R*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
76906656605SStefano Zampini       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
77006656605SStefano Zampini       ierr = MatConvert(A_RV,impMatType,MAT_REUSE_MATRIX,&A_RV);CHKERRQ(ierr);
77106656605SStefano Zampini       if (F) {
77206656605SStefano Zampini         ierr = MatMatSolve(F,A_RV,A_RRmA_RV);CHKERRQ(ierr);
77306656605SStefano Zampini       } else {
77406656605SStefano Zampini         ierr = MatDenseGetArray(A_RV,&y);CHKERRQ(ierr);
77506656605SStefano Zampini         for (i=0;i<n_vertices;i++) {
77606656605SStefano Zampini           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*n_R);CHKERRQ(ierr);
77706656605SStefano Zampini           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
77806656605SStefano Zampini           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
77906656605SStefano Zampini           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
78006656605SStefano Zampini           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
78106656605SStefano Zampini         }
78206656605SStefano Zampini         ierr = MatDenseRestoreArray(A_RV,&y);CHKERRQ(ierr);
78306656605SStefano Zampini       }
78406656605SStefano Zampini       ierr = MatScale(A_RRmA_RV,m_one);CHKERRQ(ierr);
78506656605SStefano Zampini       /* S_VV and S_CV are the subdomain contribution to coarse matrix. WARNING -> column major ordering */
78606656605SStefano Zampini       if (n_constraints) {
78706656605SStefano Zampini         Mat B;
78806656605SStefano Zampini         ierr = MatMatMult(pcbddc->local_auxmat1,A_RRmA_RV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
78906656605SStefano Zampini         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work+n_R*n_vertices,&B);CHKERRQ(ierr);
79006656605SStefano Zampini         ierr = MatMatMult(pcbddc->local_auxmat2,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
79106656605SStefano Zampini         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
79206656605SStefano Zampini         ierr = PetscBLASIntCast(n_R*n_vertices,&B_N);CHKERRQ(ierr);
79306656605SStefano Zampini         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+n_R*n_vertices,&B_one,work,&B_one));
79406656605SStefano Zampini         ierr = MatDestroy(&B);CHKERRQ(ierr);
79506656605SStefano Zampini       }
79606656605SStefano Zampini       ierr = MatConvert(A_VR,impMatType,MAT_REUSE_MATRIX,&A_VR);CHKERRQ(ierr);
79706656605SStefano Zampini       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
79806656605SStefano Zampini       ierr = MatConvert(A_VV,impMatType,MAT_REUSE_MATRIX,&A_VV);CHKERRQ(ierr);
79906656605SStefano Zampini       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
80006656605SStefano Zampini       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
80106656605SStefano Zampini       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
80206656605SStefano Zampini       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
80306656605SStefano Zampini       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
80406656605SStefano Zampini       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
80506656605SStefano Zampini       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
80606656605SStefano Zampini       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
80716f15bc4SStefano Zampini       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
80816f15bc4SStefano Zampini     } else {
80916f15bc4SStefano Zampini       ierr = MatConvert(A_VV,impMatType,MAT_REUSE_MATRIX,&A_VV);CHKERRQ(ierr);
81016f15bc4SStefano Zampini       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
81116f15bc4SStefano Zampini     }
81206656605SStefano Zampini     /* coarse basis functions */
81306656605SStefano Zampini     for (i=0;i<n_vertices;i++) {
81416f15bc4SStefano Zampini       PetscScalar *y;
81516f15bc4SStefano Zampini 
81606656605SStefano Zampini       ierr = VecPlaceArray(pcbddc->vec1_R,work+n_R*i);CHKERRQ(ierr);
81706656605SStefano Zampini       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
81806656605SStefano Zampini       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
81906656605SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
82006656605SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
82106656605SStefano Zampini       y[n_B*i+idx_V_B[i]] = 1.0;
82206656605SStefano Zampini       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
82306656605SStefano Zampini       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
82406656605SStefano Zampini 
82506656605SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
82606656605SStefano Zampini         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
82706656605SStefano Zampini         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
82806656605SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
82906656605SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
83006656605SStefano Zampini         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
83106656605SStefano Zampini         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
83206656605SStefano Zampini       }
83306656605SStefano Zampini       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
83406656605SStefano Zampini     }
83516f15bc4SStefano Zampini     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
83606656605SStefano Zampini     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
83706656605SStefano Zampini   }
83806656605SStefano Zampini 
83906656605SStefano Zampini   if (n_constraints) {
84006656605SStefano Zampini     Mat B;
84106656605SStefano Zampini 
84206656605SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
84306656605SStefano Zampini     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
84406656605SStefano Zampini     ierr = MatMatMult(pcbddc->local_auxmat2,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
84506656605SStefano Zampini     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
84606656605SStefano Zampini     if (n_vertices) {
84706656605SStefano Zampini       ierr = MatMatMult(A_VR,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_VC);CHKERRQ(ierr);
84806656605SStefano Zampini     }
84906656605SStefano Zampini     ierr = MatDestroy(&B);CHKERRQ(ierr);
85006656605SStefano Zampini     /* coarse basis functions */
85106656605SStefano Zampini     for (i=0;i<n_constraints;i++) {
85206656605SStefano Zampini       PetscScalar *y;
85306656605SStefano Zampini 
85406656605SStefano Zampini       ierr = VecPlaceArray(pcbddc->vec1_R,work+n_R*i);CHKERRQ(ierr);
85506656605SStefano Zampini       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
85606656605SStefano Zampini       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
85706656605SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
85806656605SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
85906656605SStefano Zampini       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
86006656605SStefano Zampini       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
86106656605SStefano Zampini 
86206656605SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
86306656605SStefano Zampini         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
86406656605SStefano Zampini         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
86506656605SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
86606656605SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
86706656605SStefano Zampini         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
86806656605SStefano Zampini         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
86906656605SStefano Zampini       }
87006656605SStefano Zampini       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
87106656605SStefano Zampini     }
87206656605SStefano Zampini   }
87306656605SStefano Zampini 
87406656605SStefano Zampini   /* compute other basis functions for non-symmetric problems */
87506656605SStefano Zampini   if (!pcbddc->issym) {
87606656605SStefano Zampini     Mat B,X;
87706656605SStefano Zampini 
87806656605SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,pcbddc->local_primal_size,work,&B);CHKERRQ(ierr);
87906656605SStefano Zampini 
88006656605SStefano Zampini     if (n_constraints) {
88116f15bc4SStefano Zampini       Mat S_CCT,B_C;
88206656605SStefano Zampini 
88306656605SStefano Zampini       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work+n_vertices*n_R,&B_C);CHKERRQ(ierr);
88406656605SStefano Zampini       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
88506656605SStefano Zampini       ierr = MatTransposeMatMult(C_CR,S_CCT,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
88616f15bc4SStefano Zampini       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
88706656605SStefano Zampini       if (n_vertices) {
88816f15bc4SStefano Zampini         Mat B_V,S_VCT;
88906656605SStefano Zampini 
89006656605SStefano Zampini         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&B_V);CHKERRQ(ierr);
89106656605SStefano Zampini         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
89206656605SStefano Zampini         ierr = MatTransposeMatMult(C_CR,S_VCT,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
89306656605SStefano Zampini         ierr = MatDestroy(&B_V);CHKERRQ(ierr);
89416f15bc4SStefano Zampini         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
89506656605SStefano Zampini       }
89606656605SStefano Zampini       ierr = MatDestroy(&B_C);CHKERRQ(ierr);
89706656605SStefano Zampini     }
89816f15bc4SStefano Zampini     if (n_vertices && n_R) {
89906656605SStefano Zampini       Mat          A_VRT;
90006656605SStefano Zampini       PetscBLASInt B_N,B_one = 1;
90106656605SStefano Zampini 
90206656605SStefano Zampini       if (!n_constraints) { /* if there are no constraints, reset work */
90306656605SStefano Zampini         ierr = PetscMemzero(work,n_R*pcbddc->local_primal_size*sizeof(PetscScalar));CHKERRQ(ierr);
90406656605SStefano Zampini       }
90506656605SStefano Zampini       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work+pcbddc->local_primal_size*n_R,&A_VRT);CHKERRQ(ierr);
90606656605SStefano Zampini       ierr = MatTranspose(A_VR,MAT_REUSE_MATRIX,&A_VRT);CHKERRQ(ierr);
90706656605SStefano Zampini       ierr = PetscBLASIntCast(n_vertices*n_R,&B_N);CHKERRQ(ierr);
90806656605SStefano Zampini       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&m_one,work+pcbddc->local_primal_size*n_R,&B_one,work,&B_one));
90916f15bc4SStefano Zampini       ierr = MatDestroy(&A_VRT);CHKERRQ(ierr);
91006656605SStefano Zampini     }
91106656605SStefano Zampini 
91206656605SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,pcbddc->local_primal_size,work+pcbddc->local_primal_size*n_R,&X);CHKERRQ(ierr);
91306656605SStefano Zampini     if (F) { /* currently there's no support for MatTransposeMatSolve(F,B,X) */
91406656605SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
91506656605SStefano Zampini         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
91606656605SStefano Zampini         ierr = VecPlaceArray(pcbddc->vec2_R,work+(i+pcbddc->local_primal_size)*n_R);CHKERRQ(ierr);
91706656605SStefano Zampini         ierr = MatSolveTranspose(F,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
91806656605SStefano Zampini         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
91906656605SStefano Zampini         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
92006656605SStefano Zampini       }
92106656605SStefano Zampini     } else {
92206656605SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
92306656605SStefano Zampini         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
92406656605SStefano Zampini         ierr = VecPlaceArray(pcbddc->vec2_R,work+(i+pcbddc->local_primal_size)*n_R);CHKERRQ(ierr);
92506656605SStefano Zampini         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
92606656605SStefano Zampini         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
92706656605SStefano Zampini         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
92806656605SStefano Zampini       }
92906656605SStefano Zampini     }
93006656605SStefano Zampini     ierr = MatDestroy(&B);CHKERRQ(ierr);
93106656605SStefano Zampini     /* coarse basis functions */
93206656605SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
93306656605SStefano Zampini       PetscScalar *y;
93406656605SStefano Zampini 
93506656605SStefano Zampini       ierr = VecPlaceArray(pcbddc->vec1_R,work+n_R*(i+pcbddc->local_primal_size));CHKERRQ(ierr);
93606656605SStefano Zampini       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
93706656605SStefano Zampini       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
93806656605SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
93906656605SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
94006656605SStefano Zampini       if (i<n_vertices) {
94106656605SStefano Zampini         y[n_B*i+idx_V_B[i]] = 1.0;
94206656605SStefano Zampini       }
94306656605SStefano Zampini       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
94406656605SStefano Zampini       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
94506656605SStefano Zampini 
94606656605SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
94706656605SStefano Zampini         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
94806656605SStefano Zampini         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
94906656605SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
95006656605SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
95106656605SStefano Zampini         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
95206656605SStefano Zampini         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
95306656605SStefano Zampini       }
95406656605SStefano Zampini       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
95506656605SStefano Zampini     }
95606656605SStefano Zampini     ierr = MatDestroy(&X);CHKERRQ(ierr);
95706656605SStefano Zampini   }
95806656605SStefano Zampini 
95988ebb749SStefano Zampini   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
96006656605SStefano Zampini   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
96106656605SStefano Zampini   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
96206656605SStefano Zampini   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
96306656605SStefano Zampini   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
96488ebb749SStefano Zampini   /* Checking coarse_sub_mat and coarse basis functios */
96588ebb749SStefano Zampini   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
96688ebb749SStefano Zampini   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
96725084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
96888ebb749SStefano Zampini     Mat         coarse_sub_mat;
96925084f0cSStefano Zampini     Mat         AUXMAT,TM1,TM2,TM3,TM4;
97088ebb749SStefano Zampini     Mat         coarse_phi_D,coarse_phi_B;
97188ebb749SStefano Zampini     Mat         coarse_psi_D,coarse_psi_B;
97288ebb749SStefano Zampini     Mat         A_II,A_BB,A_IB,A_BI;
9738bec7fa6SStefano Zampini     Mat         C_B,CPHI;
9748bec7fa6SStefano Zampini     IS          is_dummy;
9758bec7fa6SStefano Zampini     Vec         mones;
97688ebb749SStefano Zampini     MatType     checkmattype=MATSEQAIJ;
97788ebb749SStefano Zampini     PetscReal   real_value;
97888ebb749SStefano Zampini 
97988ebb749SStefano Zampini     ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
98088ebb749SStefano Zampini     ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
98188ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
98288ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
98388ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
98488ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
985c0553b1fSStefano Zampini     if (unsymmetric_check) {
98688ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
98788ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
98888ebb749SStefano Zampini     }
98988ebb749SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
99088ebb749SStefano Zampini 
99125084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
99206656605SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation\n");CHKERRQ(ierr);
99325084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
994c0553b1fSStefano Zampini     if (unsymmetric_check) {
99588ebb749SStefano Zampini       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
99688ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
99788ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
99888ebb749SStefano Zampini       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
99988ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
100088ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
100188ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
100288ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
100388ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
100488ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
100588ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
100688ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
100788ebb749SStefano Zampini     } else {
100888ebb749SStefano Zampini       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
100988ebb749SStefano Zampini       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
101088ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
101188ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
101288ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
101388ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
101488ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
101588ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
101688ebb749SStefano Zampini     }
101788ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
101888ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
101988ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
102088ebb749SStefano Zampini     ierr = MatConvert(TM1,MATSEQDENSE,MAT_REUSE_MATRIX,&TM1);CHKERRQ(ierr);
102181d9aea3SBarry Smith     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
10228bec7fa6SStefano Zampini     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
10230fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
102406656605SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d      matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
10258bec7fa6SStefano Zampini 
10268bec7fa6SStefano Zampini     /* check constraints */
10278bec7fa6SStefano Zampini     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size,0,1,&is_dummy);CHKERRQ(ierr);
10288bec7fa6SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);
10298bec7fa6SStefano Zampini     ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
10308bec7fa6SStefano Zampini     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
10318bec7fa6SStefano Zampini     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
10328bec7fa6SStefano Zampini     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
10338bec7fa6SStefano Zampini     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
10348bec7fa6SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
10358bec7fa6SStefano Zampini     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
10368bec7fa6SStefano Zampini     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
10378bec7fa6SStefano Zampini     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
10388bec7fa6SStefano Zampini     ierr = VecDestroy(&mones);CHKERRQ(ierr);
10398bec7fa6SStefano Zampini 
104025084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
104188ebb749SStefano Zampini     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
104288ebb749SStefano Zampini     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
104388ebb749SStefano Zampini     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
104488ebb749SStefano Zampini     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
104588ebb749SStefano Zampini     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
104688ebb749SStefano Zampini     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
104788ebb749SStefano Zampini     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
104888ebb749SStefano Zampini     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
104988ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
105088ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
1051c0553b1fSStefano Zampini     if (unsymmetric_check) {
105288ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
105388ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
105488ebb749SStefano Zampini     }
105588ebb749SStefano Zampini     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
105688ebb749SStefano Zampini   }
105706656605SStefano Zampini 
105888ebb749SStefano Zampini   /* free memory */
105906656605SStefano Zampini   ierr = PetscFree(work);CHKERRQ(ierr);
106088ebb749SStefano Zampini   if (n_vertices) {
106188ebb749SStefano Zampini     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
106288ebb749SStefano Zampini   }
106388ebb749SStefano Zampini   if (n_constraints) {
106488ebb749SStefano Zampini     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
106588ebb749SStefano Zampini   }
10668629588bSStefano Zampini   /* get back data */
10678629588bSStefano Zampini   *coarse_submat_vals_n = coarse_submat_vals;
106888ebb749SStefano Zampini   PetscFunctionReturn(0);
106988ebb749SStefano Zampini }
107088ebb749SStefano Zampini 
107188ebb749SStefano Zampini #undef __FUNCT__
1072d65f70fdSStefano Zampini #define __FUNCT__ "MatGetSubMatrixUnsorted"
1073d648f858SStefano Zampini PetscErrorCode MatGetSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
1074d65f70fdSStefano Zampini {
1075d65f70fdSStefano Zampini   Mat            *work_mat;
1076d65f70fdSStefano Zampini   IS             isrow_s,iscol_s;
1077d65f70fdSStefano Zampini   PetscBool      rsorted,csorted;
1078d65f70fdSStefano Zampini   PetscInt       rsize,*idxs_perm_r,csize,*idxs_perm_c;
1079d65f70fdSStefano Zampini   PetscErrorCode ierr;
1080d65f70fdSStefano Zampini 
1081d65f70fdSStefano Zampini   PetscFunctionBegin;
1082d65f70fdSStefano Zampini   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
1083d65f70fdSStefano Zampini   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
1084d65f70fdSStefano Zampini   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
1085d65f70fdSStefano Zampini   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
1086d65f70fdSStefano Zampini 
1087d65f70fdSStefano Zampini   if (!rsorted) {
1088d65f70fdSStefano Zampini     const PetscInt *idxs;
1089d65f70fdSStefano Zampini     PetscInt *idxs_sorted,i;
1090d65f70fdSStefano Zampini 
1091d65f70fdSStefano Zampini     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
1092d65f70fdSStefano Zampini     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
1093d65f70fdSStefano Zampini     for (i=0;i<rsize;i++) {
1094d65f70fdSStefano Zampini       idxs_perm_r[i] = i;
1095d65f70fdSStefano Zampini     }
1096d65f70fdSStefano Zampini     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
1097d65f70fdSStefano Zampini     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
1098d65f70fdSStefano Zampini     for (i=0;i<rsize;i++) {
1099d65f70fdSStefano Zampini       idxs_sorted[i] = idxs[idxs_perm_r[i]];
1100d65f70fdSStefano Zampini     }
1101d65f70fdSStefano Zampini     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
1102d65f70fdSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
1103d65f70fdSStefano Zampini   } else {
1104d65f70fdSStefano Zampini     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
1105d65f70fdSStefano Zampini     isrow_s = isrow;
1106d65f70fdSStefano Zampini   }
1107d65f70fdSStefano Zampini 
1108d65f70fdSStefano Zampini   if (!csorted) {
1109d65f70fdSStefano Zampini     if (isrow == iscol) {
1110d65f70fdSStefano Zampini       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
1111d65f70fdSStefano Zampini       iscol_s = isrow_s;
1112d65f70fdSStefano Zampini     } else {
1113d65f70fdSStefano Zampini       const PetscInt *idxs;
1114d65f70fdSStefano Zampini       PetscInt *idxs_sorted,i;
1115d65f70fdSStefano Zampini 
1116d65f70fdSStefano Zampini       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
1117d65f70fdSStefano Zampini       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
1118d65f70fdSStefano Zampini       for (i=0;i<csize;i++) {
1119d65f70fdSStefano Zampini         idxs_perm_c[i] = i;
1120d65f70fdSStefano Zampini       }
1121d65f70fdSStefano Zampini       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
1122d65f70fdSStefano Zampini       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
1123d65f70fdSStefano Zampini       for (i=0;i<csize;i++) {
1124d65f70fdSStefano Zampini         idxs_sorted[i] = idxs[idxs_perm_c[i]];
1125d65f70fdSStefano Zampini       }
1126d65f70fdSStefano Zampini       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
1127d65f70fdSStefano Zampini       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
1128d65f70fdSStefano Zampini     }
1129d65f70fdSStefano Zampini   } else {
1130d65f70fdSStefano Zampini     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
1131d65f70fdSStefano Zampini     iscol_s = iscol;
1132d65f70fdSStefano Zampini   }
1133d65f70fdSStefano Zampini 
1134d648f858SStefano Zampini   ierr = MatGetSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
1135d65f70fdSStefano Zampini 
1136d65f70fdSStefano Zampini   if (!rsorted || !csorted) {
1137d65f70fdSStefano Zampini     Mat      new_mat;
1138d65f70fdSStefano Zampini     IS       is_perm_r,is_perm_c;
1139d65f70fdSStefano Zampini 
1140d65f70fdSStefano Zampini     if (!rsorted) {
1141d65f70fdSStefano Zampini       PetscInt *idxs_r,i;
1142d65f70fdSStefano Zampini       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
1143d65f70fdSStefano Zampini       for (i=0;i<rsize;i++) {
1144d65f70fdSStefano Zampini         idxs_r[idxs_perm_r[i]] = i;
1145d65f70fdSStefano Zampini       }
1146d65f70fdSStefano Zampini       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
1147d65f70fdSStefano Zampini       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
1148d65f70fdSStefano Zampini     } else {
1149d65f70fdSStefano Zampini       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
1150d65f70fdSStefano Zampini     }
1151d65f70fdSStefano Zampini     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
1152d65f70fdSStefano Zampini 
1153d65f70fdSStefano Zampini     if (!csorted) {
1154d65f70fdSStefano Zampini       if (isrow_s == iscol_s) {
1155d65f70fdSStefano Zampini         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
1156d65f70fdSStefano Zampini         is_perm_c = is_perm_r;
1157d65f70fdSStefano Zampini       } else {
1158d65f70fdSStefano Zampini         PetscInt *idxs_c,i;
1159d65f70fdSStefano Zampini         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
1160d65f70fdSStefano Zampini         for (i=0;i<csize;i++) {
1161d65f70fdSStefano Zampini           idxs_c[idxs_perm_c[i]] = i;
1162d65f70fdSStefano Zampini         }
1163d65f70fdSStefano Zampini         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
1164d65f70fdSStefano Zampini         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
1165d65f70fdSStefano Zampini       }
1166d65f70fdSStefano Zampini     } else {
1167d65f70fdSStefano Zampini       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
1168d65f70fdSStefano Zampini     }
1169d65f70fdSStefano Zampini     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
1170d65f70fdSStefano Zampini 
1171d65f70fdSStefano Zampini     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
1172d65f70fdSStefano Zampini     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
1173d65f70fdSStefano Zampini     work_mat[0] = new_mat;
1174d65f70fdSStefano Zampini     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
1175d65f70fdSStefano Zampini     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
1176d65f70fdSStefano Zampini   }
1177d65f70fdSStefano Zampini 
1178d65f70fdSStefano Zampini   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
1179d65f70fdSStefano Zampini   *B = work_mat[0];
1180d65f70fdSStefano Zampini   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
1181d65f70fdSStefano Zampini   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
1182d65f70fdSStefano Zampini   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
1183d65f70fdSStefano Zampini   PetscFunctionReturn(0);
1184d65f70fdSStefano Zampini }
1185d65f70fdSStefano Zampini 
1186d65f70fdSStefano Zampini #undef __FUNCT__
11875e8657edSStefano Zampini #define __FUNCT__ "PCBDDCComputeLocalMatrix"
11885e8657edSStefano Zampini PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
1189aa0d41d4SStefano Zampini {
1190aa0d41d4SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
11915e8657edSStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
1192d65f70fdSStefano Zampini   Mat            new_mat;
11935e8657edSStefano Zampini   IS             is_local,is_global;
1194d65f70fdSStefano Zampini   PetscInt       local_size;
1195d65f70fdSStefano Zampini   PetscBool      isseqaij;
1196aa0d41d4SStefano Zampini   PetscErrorCode ierr;
1197aa0d41d4SStefano Zampini 
1198aa0d41d4SStefano Zampini   PetscFunctionBegin;
1199aa0d41d4SStefano Zampini   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
12005e8657edSStefano Zampini   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
12015e8657edSStefano Zampini   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
1202906d46d4SStefano Zampini   ierr = ISLocalToGlobalMappingApplyIS(matis->mapping,is_local,&is_global);CHKERRQ(ierr);
1203906d46d4SStefano Zampini   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
1204d648f858SStefano Zampini   ierr = MatGetSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
1205906d46d4SStefano Zampini   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
1206906d46d4SStefano Zampini 
1207906d46d4SStefano Zampini   /* check */
1208906d46d4SStefano Zampini   if (pcbddc->dbg_flag) {
1209906d46d4SStefano Zampini     Vec       x,x_change;
1210906d46d4SStefano Zampini     PetscReal error;
1211906d46d4SStefano Zampini 
12125e8657edSStefano Zampini     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
1213906d46d4SStefano Zampini     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
12145e8657edSStefano Zampini     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
12155e8657edSStefano Zampini     ierr = VecScatterBegin(matis->ctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
12165e8657edSStefano Zampini     ierr = VecScatterEnd(matis->ctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1217d65f70fdSStefano Zampini     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
12185e8657edSStefano Zampini     ierr = VecScatterBegin(matis->ctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
12195e8657edSStefano Zampini     ierr = VecScatterEnd(matis->ctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1220906d46d4SStefano Zampini     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
1221906d46d4SStefano Zampini     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
1222906d46d4SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1223906d46d4SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Error global vs local change on N: %1.6e\n",error);CHKERRQ(ierr);
1224906d46d4SStefano Zampini     ierr = VecDestroy(&x);CHKERRQ(ierr);
1225906d46d4SStefano Zampini     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
1226906d46d4SStefano Zampini   }
1227906d46d4SStefano Zampini 
122822d5777bSStefano Zampini   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
12299b28b3ffSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
123022d5777bSStefano Zampini   if (isseqaij) {
1231d65f70fdSStefano Zampini     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
1232aa0d41d4SStefano Zampini   } else {
1233aa0d41d4SStefano Zampini     Mat work_mat;
1234aa0d41d4SStefano Zampini     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
1235d65f70fdSStefano Zampini     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
1236aa0d41d4SStefano Zampini     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
1237aa0d41d4SStefano Zampini   }
1238d65f70fdSStefano Zampini   ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,pcbddc->issym);CHKERRQ(ierr);
1239e496cd5dSStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1240e496cd5dSStefano Zampini   ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,pcbddc->issym);CHKERRQ(ierr);
1241e496cd5dSStefano Zampini #endif
124245a1bb75SStefano Zampini   /*
124345a1bb75SStefano Zampini   ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
1244d65f70fdSStefano Zampini   ierr = MatView(new_mat,(PetscViewer)0);CHKERRQ(ierr);
124545a1bb75SStefano Zampini   */
1246d65f70fdSStefano Zampini   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
1247aa0d41d4SStefano Zampini   PetscFunctionReturn(0);
1248aa0d41d4SStefano Zampini }
1249aa0d41d4SStefano Zampini 
1250aa0d41d4SStefano Zampini #undef __FUNCT__
1251a64d13efSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalScatters"
12528ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
1253a64d13efSStefano Zampini {
1254a64d13efSStefano Zampini   PC_IS*         pcis = (PC_IS*)(pc->data);
1255a64d13efSStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
12568ce42a96SStefano Zampini   IS             is_aux1,is_aux2;
1257e9189074SStefano Zampini   PetscInt       *aux_array1,*aux_array2,*is_indices,*idx_R_local;
12583a50541eSStefano Zampini   PetscInt       n_vertices,i,j,n_R,n_D,n_B;
12593a50541eSStefano Zampini   PetscInt       vbs,bs;
12604641a718SStefano Zampini   PetscBT        bitmask;
1261a64d13efSStefano Zampini   PetscErrorCode ierr;
1262a64d13efSStefano Zampini 
1263a64d13efSStefano Zampini   PetscFunctionBegin;
1264b23d619eSStefano Zampini   /*
1265b23d619eSStefano Zampini     No need to setup local scatters if
1266b23d619eSStefano Zampini       - primal space is unchanged
1267b23d619eSStefano Zampini         AND
1268b23d619eSStefano Zampini       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
1269b23d619eSStefano Zampini         AND
1270b23d619eSStefano Zampini       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
1271b23d619eSStefano Zampini   */
1272b23d619eSStefano Zampini   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
1273f4ddd8eeSStefano Zampini     PetscFunctionReturn(0);
1274f4ddd8eeSStefano Zampini   }
1275f4ddd8eeSStefano Zampini   /* destroy old objects */
1276f4ddd8eeSStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
1277f4ddd8eeSStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
1278f4ddd8eeSStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
1279a64d13efSStefano Zampini   /* Set Non-overlapping dimensions */
1280a64d13efSStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
1281e9189074SStefano Zampini   n_vertices = pcbddc->n_actual_vertices;
12824641a718SStefano Zampini   /* create auxiliary bitmask */
12834641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
12844641a718SStefano Zampini   for (i=0;i<n_vertices;i++) {
1285e9189074SStefano Zampini     ierr = PetscBTSet(bitmask,pcbddc->primal_indices_local_idxs[i]);CHKERRQ(ierr);
12864641a718SStefano Zampini   }
12873a50541eSStefano Zampini 
1288a64d13efSStefano Zampini   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
1289854ce69bSBarry Smith   ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
1290a64d13efSStefano Zampini   for (i=0, n_R=0; i<pcis->n; i++) {
12914641a718SStefano Zampini     if (!PetscBTLookup(bitmask,i)) {
1292a64d13efSStefano Zampini       idx_R_local[n_R] = i;
1293a64d13efSStefano Zampini       n_R++;
1294a64d13efSStefano Zampini     }
1295a64d13efSStefano Zampini   }
12963a50541eSStefano Zampini 
12973a50541eSStefano Zampini   /* Block code */
12983a50541eSStefano Zampini   vbs = 1;
12993a50541eSStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
13003a50541eSStefano Zampini   if (bs>1 && !(n_vertices%bs)) {
13013a50541eSStefano Zampini     PetscBool is_blocked = PETSC_TRUE;
13023a50541eSStefano Zampini     PetscInt  *vary;
13033a50541eSStefano Zampini     /* Verify if the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
1304785e854fSJed Brown     ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
13053a50541eSStefano Zampini     ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
1306e9189074SStefano Zampini     for (i=0; i<n_vertices; i++) vary[pcbddc->primal_indices_local_idxs[i]/bs]++;
1307964fefecSStefano Zampini     for (i=0; i<n_vertices/bs; i++) {
13083a50541eSStefano Zampini       if (vary[i]!=0 && vary[i]!=bs) {
13093a50541eSStefano Zampini         is_blocked = PETSC_FALSE;
13103a50541eSStefano Zampini         break;
13113a50541eSStefano Zampini       }
13123a50541eSStefano Zampini     }
13133a50541eSStefano Zampini     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
13143a50541eSStefano Zampini       vbs = bs;
13153a50541eSStefano Zampini       for (i=0;i<n_R/vbs;i++) {
13163a50541eSStefano Zampini         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
13173a50541eSStefano Zampini       }
13183a50541eSStefano Zampini     }
13193a50541eSStefano Zampini     ierr = PetscFree(vary);CHKERRQ(ierr);
13203a50541eSStefano Zampini   }
13213a50541eSStefano Zampini   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
13223a50541eSStefano Zampini   ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
1323a64d13efSStefano Zampini 
1324a64d13efSStefano Zampini   /* print some info if requested */
1325a64d13efSStefano Zampini   if (pcbddc->dbg_flag) {
1326a64d13efSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1327a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
13280fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1329a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
1330a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
13313a50541eSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"r_size = %d, v_size = %d, constraints = %d, local_primal_size = %d\n",n_R,n_vertices,pcbddc->local_primal_size-n_vertices,pcbddc->local_primal_size);CHKERRQ(ierr);
1332a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr);
1333a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1334a64d13efSStefano Zampini   }
1335a64d13efSStefano Zampini 
1336a64d13efSStefano Zampini   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
13373a50541eSStefano Zampini   ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
1338854ce69bSBarry Smith   ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
1339854ce69bSBarry Smith   ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
1340a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
13414641a718SStefano Zampini   for (i=0; i<n_D; i++) {
13424641a718SStefano Zampini     ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
13434641a718SStefano Zampini   }
1344a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1345a64d13efSStefano Zampini   for (i=0, j=0; i<n_R; i++) {
13464641a718SStefano Zampini     if (!PetscBTLookup(bitmask,idx_R_local[i])) {
13474641a718SStefano Zampini       aux_array1[j++] = i;
1348a64d13efSStefano Zampini     }
1349a64d13efSStefano Zampini   }
1350a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
1351a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1352a64d13efSStefano Zampini   for (i=0, j=0; i<n_B; i++) {
13534641a718SStefano Zampini     if (!PetscBTLookup(bitmask,is_indices[i])) {
13544641a718SStefano Zampini       aux_array2[j++] = i;
1355a64d13efSStefano Zampini     }
1356a64d13efSStefano Zampini   }
1357a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1358a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
1359a64d13efSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
1360a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
1361a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
1362a64d13efSStefano Zampini 
13638eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
1364785e854fSJed Brown     ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
1365a64d13efSStefano Zampini     for (i=0, j=0; i<n_R; i++) {
13664641a718SStefano Zampini       if (PetscBTLookup(bitmask,idx_R_local[i])) {
13674641a718SStefano Zampini         aux_array1[j++] = i;
1368a64d13efSStefano Zampini       }
1369a64d13efSStefano Zampini     }
1370a64d13efSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
1371a64d13efSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
1372a64d13efSStefano Zampini     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
1373a64d13efSStefano Zampini   }
13744641a718SStefano Zampini   ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
13753a50541eSStefano Zampini   ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
1376a64d13efSStefano Zampini   PetscFunctionReturn(0);
1377a64d13efSStefano Zampini }
1378a64d13efSStefano Zampini 
1379304d26faSStefano Zampini 
1380304d26faSStefano Zampini #undef __FUNCT__
1381304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
1382684f6988SStefano Zampini PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
1383304d26faSStefano Zampini {
1384304d26faSStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1385304d26faSStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
1386304d26faSStefano Zampini   PC             pc_temp;
1387304d26faSStefano Zampini   Mat            A_RR;
1388f4ddd8eeSStefano Zampini   MatReuse       reuse;
1389304d26faSStefano Zampini   PetscScalar    m_one = -1.0;
1390304d26faSStefano Zampini   PetscReal      value;
1391af732b37SStefano Zampini   PetscInt       n_D,n_R,ibs,mbs;
13929577ea80SStefano Zampini   PetscBool      use_exact,use_exact_reduced,issbaij;
1393304d26faSStefano Zampini   PetscErrorCode ierr;
1394e604994aSStefano Zampini   /* prefixes stuff */
1395312be037SStefano Zampini   char           dir_prefix[256],neu_prefix[256],str_level[16];
1396e604994aSStefano Zampini   size_t         len;
1397304d26faSStefano Zampini 
1398304d26faSStefano Zampini   PetscFunctionBegin;
1399304d26faSStefano Zampini 
1400e604994aSStefano Zampini   /* compute prefixes */
1401e604994aSStefano Zampini   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
1402e604994aSStefano Zampini   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
1403e604994aSStefano Zampini   if (!pcbddc->current_level) {
1404e604994aSStefano Zampini     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
1405e604994aSStefano Zampini     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
1406e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
1407e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
1408e604994aSStefano Zampini   } else {
1409e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
1410312be037SStefano Zampini     sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
1411e604994aSStefano Zampini     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
1412e604994aSStefano Zampini     len -= 15; /* remove "pc_bddc_coarse_" */
1413312be037SStefano Zampini     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
1414312be037SStefano Zampini     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
141534d6797cSStefano Zampini     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
141634d6797cSStefano Zampini     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
1417e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
1418e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
1419e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
1420e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
1421e604994aSStefano Zampini   }
1422e604994aSStefano Zampini 
1423304d26faSStefano Zampini   /* DIRICHLET PROBLEM */
1424684f6988SStefano Zampini   if (dirichlet) {
1425d5574798SStefano Zampini     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
1426964fefecSStefano Zampini     if (pcbddc->issym) {
1427964fefecSStefano Zampini       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
1428964fefecSStefano Zampini     }
1429ac78edfcSStefano Zampini     /* Matrix for Dirichlet problem is pcis->A_II */
1430964fefecSStefano Zampini     n_D = pcis->n - pcis->n_B;
1431304d26faSStefano Zampini     if (!pcbddc->ksp_D) { /* create object if not yet build */
1432304d26faSStefano Zampini       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
1433304d26faSStefano Zampini       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
1434304d26faSStefano Zampini       /* default */
1435304d26faSStefano Zampini       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
1436e604994aSStefano Zampini       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
14379577ea80SStefano Zampini       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
1438304d26faSStefano Zampini       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
14399577ea80SStefano Zampini       if (issbaij) {
14409577ea80SStefano Zampini         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
14419577ea80SStefano Zampini       } else {
1442304d26faSStefano Zampini         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
14439577ea80SStefano Zampini       }
1444304d26faSStefano Zampini       /* Allow user's customization */
1445304d26faSStefano Zampini       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
1446304d26faSStefano Zampini       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1447304d26faSStefano Zampini     }
1448d1e9a80fSBarry Smith     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
1449d5574798SStefano Zampini     if (sub_schurs->interior_solver) {
1450d5574798SStefano Zampini       ierr = KSPSetPC(pcbddc->ksp_D,sub_schurs->interior_solver);CHKERRQ(ierr);
1451d5574798SStefano Zampini     }
1452304d26faSStefano Zampini     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1453304d26faSStefano Zampini     if (!n_D) {
1454304d26faSStefano Zampini       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
1455304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1456304d26faSStefano Zampini     }
1457304d26faSStefano Zampini     /* Set Up KSP for Dirichlet problem of BDDC */
1458304d26faSStefano Zampini     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
1459304d26faSStefano Zampini     /* set ksp_D into pcis data */
1460304d26faSStefano Zampini     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
1461304d26faSStefano Zampini     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
1462304d26faSStefano Zampini     pcis->ksp_D = pcbddc->ksp_D;
1463684f6988SStefano Zampini   }
1464304d26faSStefano Zampini 
1465304d26faSStefano Zampini   /* NEUMANN PROBLEM */
1466684f6988SStefano Zampini   A_RR = 0;
1467684f6988SStefano Zampini   if (neumann) {
1468f4ddd8eeSStefano Zampini     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
14698ce42a96SStefano Zampini     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
1470f4ddd8eeSStefano Zampini     if (pcbddc->ksp_R) { /* already created ksp */
1471f4ddd8eeSStefano Zampini       PetscInt nn_R;
147281d9aea3SBarry Smith       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
1473f4ddd8eeSStefano Zampini       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
1474f4ddd8eeSStefano Zampini       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
1475f4ddd8eeSStefano Zampini       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
1476f4ddd8eeSStefano Zampini         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
1477f4ddd8eeSStefano Zampini         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1478f4ddd8eeSStefano Zampini         reuse = MAT_INITIAL_MATRIX;
1479f4ddd8eeSStefano Zampini       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
1480727cdba6SStefano Zampini         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
1481f4ddd8eeSStefano Zampini           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1482f4ddd8eeSStefano Zampini           reuse = MAT_INITIAL_MATRIX;
1483f4ddd8eeSStefano Zampini         } else { /* safe to reuse the matrix */
1484f4ddd8eeSStefano Zampini           reuse = MAT_REUSE_MATRIX;
1485f4ddd8eeSStefano Zampini         }
1486f4ddd8eeSStefano Zampini       }
1487f4ddd8eeSStefano Zampini       /* last check */
1488d1e9a80fSBarry Smith       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
1489f4ddd8eeSStefano Zampini         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1490f4ddd8eeSStefano Zampini         reuse = MAT_INITIAL_MATRIX;
1491f4ddd8eeSStefano Zampini       }
1492f4ddd8eeSStefano Zampini     } else { /* first time, so we need to create the matrix */
1493f4ddd8eeSStefano Zampini       reuse = MAT_INITIAL_MATRIX;
1494f4ddd8eeSStefano Zampini     }
1495f4ddd8eeSStefano Zampini     /* extract A_RR */
1496af732b37SStefano Zampini     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
1497af732b37SStefano Zampini     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
14983a50541eSStefano Zampini     if (ibs != mbs) {
1499af732b37SStefano Zampini       Mat newmat;
1500af732b37SStefano Zampini       ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
1501f4ddd8eeSStefano Zampini       ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
1502af732b37SStefano Zampini       ierr = MatDestroy(&newmat);CHKERRQ(ierr);
1503af732b37SStefano Zampini     } else {
1504f4ddd8eeSStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
1505af732b37SStefano Zampini     }
1506964fefecSStefano Zampini     if (pcbddc->issym) {
1507964fefecSStefano Zampini       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
1508964fefecSStefano Zampini     }
1509f4ddd8eeSStefano Zampini     if (!pcbddc->ksp_R) { /* create object if not present */
1510304d26faSStefano Zampini       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
1511304d26faSStefano Zampini       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
1512304d26faSStefano Zampini       /* default */
1513304d26faSStefano Zampini       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
1514e604994aSStefano Zampini       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
1515304d26faSStefano Zampini       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
15169577ea80SStefano Zampini       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
15179577ea80SStefano Zampini       if (issbaij) {
15189577ea80SStefano Zampini         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
15199577ea80SStefano Zampini       } else {
1520304d26faSStefano Zampini         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
15219577ea80SStefano Zampini       }
1522304d26faSStefano Zampini       /* Allow user's customization */
1523304d26faSStefano Zampini       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
1524304d26faSStefano Zampini       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1525304d26faSStefano Zampini     }
1526d1e9a80fSBarry Smith     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
1527304d26faSStefano Zampini     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1528304d26faSStefano Zampini     if (!n_R) {
1529304d26faSStefano Zampini       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
1530304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1531304d26faSStefano Zampini     }
1532304d26faSStefano Zampini     /* Set Up KSP for Neumann problem of BDDC */
1533304d26faSStefano Zampini     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
1534684f6988SStefano Zampini   }
1535304d26faSStefano Zampini 
1536304d26faSStefano Zampini   /* check Dirichlet and Neumann solvers and adapt them if a nullspace correction is needed */
15370fccc4e9SStefano Zampini   if (pcbddc->NullSpace || pcbddc->dbg_flag) {
1538684f6988SStefano Zampini     if (pcbddc->dbg_flag) {
1539684f6988SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1540684f6988SStefano Zampini       ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1541684f6988SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1542684f6988SStefano Zampini     }
1543684f6988SStefano Zampini     if (dirichlet) { /* Dirichlet */
15440fccc4e9SStefano Zampini       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
15450fccc4e9SStefano Zampini       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
15460fccc4e9SStefano Zampini       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
15470fccc4e9SStefano Zampini       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
15480fccc4e9SStefano Zampini       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
1549304d26faSStefano Zampini       /* need to be adapted? */
1550b8ffe317SStefano Zampini       use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1551b8ffe317SStefano Zampini       ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1552b8ffe317SStefano Zampini       ierr = PCBDDCSetUseExactDirichlet(pc,use_exact_reduced);CHKERRQ(ierr);
1553304d26faSStefano Zampini       /* print info */
1554304d26faSStefano Zampini       if (pcbddc->dbg_flag) {
1555e604994aSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Dirichlet solve (%s) = % 1.14e \n",PetscGlobalRank,((PetscObject)(pcbddc->ksp_D))->prefix,value);CHKERRQ(ierr);
1556304d26faSStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1557304d26faSStefano Zampini       }
1558b8ffe317SStefano Zampini       if (pcbddc->NullSpace && !use_exact_reduced && !pcbddc->switch_static) {
15598ce42a96SStefano Zampini         ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcis->is_I_local);CHKERRQ(ierr);
1560304d26faSStefano Zampini       }
1561684f6988SStefano Zampini     }
1562684f6988SStefano Zampini     if (neumann) { /* Neumann */
15630fccc4e9SStefano Zampini       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
15640fccc4e9SStefano Zampini       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
15650fccc4e9SStefano Zampini       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
15660fccc4e9SStefano Zampini       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
15670fccc4e9SStefano Zampini       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
1568304d26faSStefano Zampini       /* need to be adapted? */
1569b8ffe317SStefano Zampini       use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1570b8ffe317SStefano Zampini       ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1571304d26faSStefano Zampini       /* print info */
1572304d26faSStefano Zampini       if (pcbddc->dbg_flag) {
1573e604994aSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Neumann solve (%s) = % 1.14e\n",PetscGlobalRank,((PetscObject)(pcbddc->ksp_R))->prefix,value);CHKERRQ(ierr);
1574304d26faSStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1575304d26faSStefano Zampini       }
1576b8ffe317SStefano Zampini       if (pcbddc->NullSpace && !use_exact_reduced) { /* is it the right logic? */
15778ce42a96SStefano Zampini         ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcbddc->is_R_local);CHKERRQ(ierr);
1578304d26faSStefano Zampini       }
15790fccc4e9SStefano Zampini     }
1580684f6988SStefano Zampini   }
1581304d26faSStefano Zampini   /* free Neumann problem's matrix */
1582304d26faSStefano Zampini   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1583304d26faSStefano Zampini   PetscFunctionReturn(0);
1584304d26faSStefano Zampini }
1585304d26faSStefano Zampini 
1586304d26faSStefano Zampini #undef __FUNCT__
1587ba15a52eSStefano Zampini #define __FUNCT__ "PCBDDCSolveSubstructureCorrection"
158820c7b377SStefano Zampini static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec rhs, Vec sol, Vec work, PetscBool applytranspose)
1589674ae819SStefano Zampini {
1590674ae819SStefano Zampini   PetscErrorCode ierr;
1591674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1592674ae819SStefano Zampini 
1593674ae819SStefano Zampini   PetscFunctionBegin;
159420c7b377SStefano Zampini   if (applytranspose) {
1595674ae819SStefano Zampini     if (pcbddc->local_auxmat1) {
159620c7b377SStefano Zampini       ierr = MatMultTranspose(pcbddc->local_auxmat2,rhs,work);CHKERRQ(ierr);
159720c7b377SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,work,rhs,rhs);CHKERRQ(ierr);
159820c7b377SStefano Zampini     }
159920c7b377SStefano Zampini     ierr = KSPSolveTranspose(pcbddc->ksp_R,rhs,sol);CHKERRQ(ierr);
160020c7b377SStefano Zampini   } else {
160120c7b377SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,rhs,sol);CHKERRQ(ierr);
160220c7b377SStefano Zampini     if (pcbddc->local_auxmat1) {
160320c7b377SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,sol,work);CHKERRQ(ierr);
160420c7b377SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,work,sol,sol);CHKERRQ(ierr);
160520c7b377SStefano Zampini     }
1606674ae819SStefano Zampini   }
1607674ae819SStefano Zampini   PetscFunctionReturn(0);
1608674ae819SStefano Zampini }
1609674ae819SStefano Zampini 
1610dc359a40SStefano Zampini /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
1611674ae819SStefano Zampini #undef __FUNCT__
1612674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
1613dc359a40SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
1614674ae819SStefano Zampini {
1615674ae819SStefano Zampini   PetscErrorCode ierr;
1616674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
1617674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
1618674ae819SStefano Zampini   const PetscScalar zero = 0.0;
1619674ae819SStefano Zampini 
1620674ae819SStefano Zampini   PetscFunctionBegin;
1621dc359a40SStefano Zampini   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
1622dc359a40SStefano Zampini   if (applytranspose) {
1623674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
16248eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
1625dc359a40SStefano Zampini   } else {
1626674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
1627674ae819SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
162815aaf578SStefano Zampini   }
162912edc857SStefano Zampini   /* start communications from local primal nodes to rhs of coarse solver */
163012edc857SStefano Zampini   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
163112edc857SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
163212edc857SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
163312edc857SStefano Zampini 
16349f00e9b4SStefano Zampini   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
163512edc857SStefano Zampini   /* TODO remove null space when doing multilevel */
163612edc857SStefano Zampini   if (pcbddc->coarse_ksp) {
1637964fefecSStefano Zampini     Vec rhs,sol;
1638964fefecSStefano Zampini 
1639964fefecSStefano Zampini     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
1640964fefecSStefano Zampini     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
164112edc857SStefano Zampini     if (applytranspose) {
1642964fefecSStefano Zampini       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
164312edc857SStefano Zampini     } else {
1644964fefecSStefano Zampini       ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
164512edc857SStefano Zampini     }
164612edc857SStefano Zampini   }
1647674ae819SStefano Zampini 
1648674ae819SStefano Zampini   /* Local solution on R nodes */
16499f00e9b4SStefano Zampini   if (pcis->n) {
1650674ae819SStefano Zampini     ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1651674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1652674ae819SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
16538eeda7d8SStefano Zampini     if (pcbddc->switch_static) {
1654674ae819SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1655674ae819SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1656674ae819SStefano Zampini     }
165720c7b377SStefano Zampini     ierr = PCBDDCSolveSubstructureCorrection(pc,pcbddc->vec1_R,pcbddc->vec2_R,pcbddc->vec1_C,applytranspose);CHKERRQ(ierr);
1658674ae819SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1659674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1660674ae819SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
16618eeda7d8SStefano Zampini     if (pcbddc->switch_static) {
1662674ae819SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1663674ae819SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1664674ae819SStefano Zampini     }
16659f00e9b4SStefano Zampini   }
1666674ae819SStefano Zampini 
16679f00e9b4SStefano Zampini   /* communications from coarse sol to local primal nodes */
16689f00e9b4SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
166912edc857SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1670674ae819SStefano Zampini 
1671674ae819SStefano Zampini   /* Sum contributions from two levels */
1672dc359a40SStefano Zampini   if (applytranspose) {
1673dc359a40SStefano Zampini     ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
1674dc359a40SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1675dc359a40SStefano Zampini   } else {
1676674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
16778eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1678dc359a40SStefano Zampini   }
1679674ae819SStefano Zampini   PetscFunctionReturn(0);
1680674ae819SStefano Zampini }
1681674ae819SStefano Zampini 
1682674ae819SStefano Zampini #undef __FUNCT__
1683674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
168412edc857SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
1685674ae819SStefano Zampini {
1686674ae819SStefano Zampini   PetscErrorCode ierr;
1687674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
168858da7f69SStefano Zampini   PetscScalar    *array;
168912edc857SStefano Zampini   Vec            from,to;
1690674ae819SStefano Zampini 
1691674ae819SStefano Zampini   PetscFunctionBegin;
169212edc857SStefano Zampini   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
169312edc857SStefano Zampini     from = pcbddc->coarse_vec;
169412edc857SStefano Zampini     to = pcbddc->vec1_P;
169512edc857SStefano Zampini     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
169612edc857SStefano Zampini       Vec tvec;
169758da7f69SStefano Zampini 
169858da7f69SStefano Zampini       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
169958da7f69SStefano Zampini       ierr = VecResetArray(tvec);CHKERRQ(ierr);
170012edc857SStefano Zampini       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
170158da7f69SStefano Zampini       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
170258da7f69SStefano Zampini       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
170358da7f69SStefano Zampini       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
170412edc857SStefano Zampini     }
170512edc857SStefano Zampini   } else { /* from local to global -> put data in coarse right hand side */
170612edc857SStefano Zampini     from = pcbddc->vec1_P;
170712edc857SStefano Zampini     to = pcbddc->coarse_vec;
170812edc857SStefano Zampini   }
170912edc857SStefano Zampini   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
1710674ae819SStefano Zampini   PetscFunctionReturn(0);
1711674ae819SStefano Zampini }
1712674ae819SStefano Zampini 
1713674ae819SStefano Zampini #undef __FUNCT__
1714674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
171512edc857SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
1716674ae819SStefano Zampini {
1717674ae819SStefano Zampini   PetscErrorCode ierr;
1718674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
171958da7f69SStefano Zampini   PetscScalar    *array;
172012edc857SStefano Zampini   Vec            from,to;
1721674ae819SStefano Zampini 
1722674ae819SStefano Zampini   PetscFunctionBegin;
172312edc857SStefano Zampini   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
172412edc857SStefano Zampini     from = pcbddc->coarse_vec;
172512edc857SStefano Zampini     to = pcbddc->vec1_P;
172612edc857SStefano Zampini   } else { /* from local to global -> put data in coarse right hand side */
172712edc857SStefano Zampini     from = pcbddc->vec1_P;
172812edc857SStefano Zampini     to = pcbddc->coarse_vec;
172912edc857SStefano Zampini   }
173012edc857SStefano Zampini   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
173112edc857SStefano Zampini   if (smode == SCATTER_FORWARD) {
173212edc857SStefano Zampini     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
173312edc857SStefano Zampini       Vec tvec;
173458da7f69SStefano Zampini 
173512edc857SStefano Zampini       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
173658da7f69SStefano Zampini       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
173758da7f69SStefano Zampini       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
173858da7f69SStefano Zampini       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
173958da7f69SStefano Zampini     }
174058da7f69SStefano Zampini   } else {
174158da7f69SStefano Zampini     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
174258da7f69SStefano Zampini      ierr = VecResetArray(from);CHKERRQ(ierr);
174312edc857SStefano Zampini     }
174412edc857SStefano Zampini   }
1745674ae819SStefano Zampini   PetscFunctionReturn(0);
1746674ae819SStefano Zampini }
1747674ae819SStefano Zampini 
1748984c4197SStefano Zampini /* uncomment for testing purposes */
1749984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */
1750674ae819SStefano Zampini #undef __FUNCT__
1751674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
1752674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
1753674ae819SStefano Zampini {
1754674ae819SStefano Zampini   PetscErrorCode    ierr;
1755674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
1756674ae819SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1757674ae819SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
1758984c4197SStefano Zampini   /* one and zero */
1759984c4197SStefano Zampini   PetscScalar       one=1.0,zero=0.0;
1760984c4197SStefano Zampini   /* space to store constraints and their local indices */
1761984c4197SStefano Zampini   PetscScalar       *temp_quadrature_constraint;
1762984c4197SStefano Zampini   PetscInt          *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B;
1763984c4197SStefano Zampini   /* iterators */
1764984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
1765984c4197SStefano Zampini   /* BLAS integers */
1766e310c8b4SStefano Zampini   PetscBLASInt      lwork,lierr;
1767e310c8b4SStefano Zampini   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
1768c4303822SStefano Zampini   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
1769727cdba6SStefano Zampini   /* reuse */
1770727cdba6SStefano Zampini   PetscInt          olocal_primal_size;
1771727cdba6SStefano Zampini   PetscInt          *oprimal_indices_local_idxs;
1772984c4197SStefano Zampini   /* change of basis */
1773a717540cSStefano Zampini   PetscBool         boolforchange,qr_needed;
1774a717540cSStefano Zampini   PetscBT           touched,change_basis,qr_needed_idx;
1775984c4197SStefano Zampini   /* auxiliary stuff */
177664efe560SStefano Zampini   PetscInt          *nnz,*is_indices;
17778a0068c3SStefano Zampini   PetscInt          ncc;
1778984c4197SStefano Zampini   /* some quantities */
177945a1bb75SStefano Zampini   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
1780a58a30b4SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
1781984c4197SStefano Zampini 
1782674ae819SStefano Zampini   PetscFunctionBegin;
17838e61c736SStefano Zampini   /* Destroy Mat objects computed previously */
17848e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
17858e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1786088faed8SStefano Zampini   /* save info on constraints from previous setup (if any) */
1787088faed8SStefano Zampini   olocal_primal_size = pcbddc->local_primal_size;
1788088faed8SStefano Zampini   ierr = PetscMalloc1(olocal_primal_size,&oprimal_indices_local_idxs);CHKERRQ(ierr);
1789088faed8SStefano Zampini   ierr = PetscMemcpy(oprimal_indices_local_idxs,pcbddc->primal_indices_local_idxs,olocal_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
1790088faed8SStefano Zampini   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
1791cf5a6209SStefano Zampini 
1792cf5a6209SStefano Zampini   /* print some info */
1793cf5a6209SStefano Zampini   if (pcbddc->dbg_flag) {
1794cf5a6209SStefano Zampini     IS       vertices;
1795cf5a6209SStefano Zampini     PetscInt nv,nedges,nfaces;
1796cf5a6209SStefano Zampini     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
1797cf5a6209SStefano Zampini     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
1798cf5a6209SStefano Zampini     ierr = ISDestroy(&vertices);CHKERRQ(ierr);
1799cf5a6209SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1800cf5a6209SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1801cf5a6209SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
1802fd14bc51SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
1803fd14bc51SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
1804cf5a6209SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1805cf5a6209SStefano Zampini   }
1806cf5a6209SStefano Zampini 
1807cf5a6209SStefano Zampini   if (!pcbddc->adaptive_selection) {
1808cf5a6209SStefano Zampini     IS           ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
1809cf5a6209SStefano Zampini     MatNullSpace nearnullsp;
1810cf5a6209SStefano Zampini     const Vec    *nearnullvecs;
1811cf5a6209SStefano Zampini     Vec          *localnearnullsp;
1812cf5a6209SStefano Zampini     PetscScalar  *array;
1813cf5a6209SStefano Zampini     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
1814cf5a6209SStefano Zampini     PetscBool    nnsp_has_cnst;
1815cf5a6209SStefano Zampini     /* LAPACK working arrays for SVD or POD */
1816cf5a6209SStefano Zampini     PetscBool    skip_lapack;
1817cf5a6209SStefano Zampini     PetscScalar  *work;
1818cf5a6209SStefano Zampini     PetscReal    *singular_vals;
1819cf5a6209SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1820cf5a6209SStefano Zampini     PetscReal    *rwork;
1821cf5a6209SStefano Zampini #endif
1822cf5a6209SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1823cf5a6209SStefano Zampini     PetscScalar  *temp_basis,*correlation_mat;
1824cf5a6209SStefano Zampini #else
1825964fefecSStefano Zampini     PetscBLASInt dummy_int=1;
1826964fefecSStefano Zampini     PetscScalar  dummy_scalar=1.;
1827cf5a6209SStefano Zampini #endif
1828cf5a6209SStefano Zampini 
1829674ae819SStefano Zampini     /* Get index sets for faces, edges and vertices from graph */
1830d06fc5fdSStefano Zampini     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
1831d06fc5fdSStefano Zampini     /* free unneeded index sets */
1832d06fc5fdSStefano Zampini     if (!pcbddc->use_vertices) {
1833d06fc5fdSStefano Zampini       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
1834674ae819SStefano Zampini     }
1835d06fc5fdSStefano Zampini     if (!pcbddc->use_edges) {
1836d06fc5fdSStefano Zampini       for (i=0;i<n_ISForEdges;i++) {
1837d06fc5fdSStefano Zampini         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1838d06fc5fdSStefano Zampini       }
1839d06fc5fdSStefano Zampini       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1840d06fc5fdSStefano Zampini       n_ISForEdges = 0;
1841d06fc5fdSStefano Zampini     }
1842d06fc5fdSStefano Zampini     if (!pcbddc->use_faces) {
1843d06fc5fdSStefano Zampini       for (i=0;i<n_ISForFaces;i++) {
1844d06fc5fdSStefano Zampini         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1845d06fc5fdSStefano Zampini       }
1846d06fc5fdSStefano Zampini       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1847d06fc5fdSStefano Zampini       n_ISForFaces = 0;
1848d06fc5fdSStefano Zampini     }
1849*70022509SStefano Zampini 
1850*70022509SStefano Zampini #if defined(PETSC_USE_DEBUG)
1851*70022509SStefano Zampini     /* HACK: when solving singular problems not using vertices, a change of basis is mandatory.
1852*70022509SStefano Zampini        Also use_change_of_basis should be consistent among processors */
1853*70022509SStefano Zampini     if (pcbddc->NullSpace) {
1854*70022509SStefano Zampini       PetscBool tbool[2],gbool[2];
1855*70022509SStefano Zampini 
1856*70022509SStefano Zampini       if (!ISForVertices && !pcbddc->user_ChangeOfBasisMatrix) {
1857b8ffe317SStefano Zampini         pcbddc->use_change_of_basis = PETSC_TRUE;
1858d06fc5fdSStefano Zampini         if (!ISForEdges) {
1859d06fc5fdSStefano Zampini           pcbddc->use_change_on_faces = PETSC_TRUE;
1860d06fc5fdSStefano Zampini         }
1861b8ffe317SStefano Zampini       }
1862d06fc5fdSStefano Zampini       tbool[0] = pcbddc->use_change_of_basis;
1863d06fc5fdSStefano Zampini       tbool[1] = pcbddc->use_change_on_faces;
1864d06fc5fdSStefano Zampini       ierr = MPI_Allreduce(tbool,gbool,2,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1865d06fc5fdSStefano Zampini       pcbddc->use_change_of_basis = gbool[0];
1866d06fc5fdSStefano Zampini       pcbddc->use_change_on_faces = gbool[1];
186798a51de6SStefano Zampini     }
1868*70022509SStefano Zampini #endif
186908122e43SStefano Zampini 
1870674ae819SStefano Zampini     /* check if near null space is attached to global mat */
1871674ae819SStefano Zampini     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
1872674ae819SStefano Zampini     if (nearnullsp) {
1873674ae819SStefano Zampini       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
1874f4ddd8eeSStefano Zampini       /* remove any stored info */
1875f4ddd8eeSStefano Zampini       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
1876f4ddd8eeSStefano Zampini       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1877f4ddd8eeSStefano Zampini       /* store information for BDDC solver reuse */
1878f4ddd8eeSStefano Zampini       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
1879f4ddd8eeSStefano Zampini       pcbddc->onearnullspace = nearnullsp;
1880473ba861SJed Brown       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1881f4ddd8eeSStefano Zampini       for (i=0;i<nnsp_size;i++) {
1882f4ddd8eeSStefano Zampini         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
1883f4ddd8eeSStefano Zampini       }
1884984c4197SStefano Zampini     } else { /* if near null space is not provided BDDC uses constants by default */
1885984c4197SStefano Zampini       nnsp_size = 0;
1886674ae819SStefano Zampini       nnsp_has_cnst = PETSC_TRUE;
1887674ae819SStefano Zampini     }
1888984c4197SStefano Zampini     /* get max number of constraints on a single cc */
1889984c4197SStefano Zampini     max_constraints = nnsp_size;
1890984c4197SStefano Zampini     if (nnsp_has_cnst) max_constraints++;
1891984c4197SStefano Zampini 
1892674ae819SStefano Zampini     /*
1893674ae819SStefano Zampini          Evaluate maximum storage size needed by the procedure
1894674ae819SStefano Zampini          - temp_indices will contain start index of each constraint stored as follows
1895911cabfeSStefano Zampini          - temp_indices_to_constraint  [temp_indices[i],...,temp_indices[i+1]-1] will contain the indices (in local numbering) on which the constraint acts
1896911cabfeSStefano Zampini          - temp_indices_to_constraint_B[temp_indices[i],...,temp_indices[i+1]-1] will contain the indices (in boundary numbering) on which the constraint acts
1897911cabfeSStefano Zampini          - temp_quadrature_constraint  [temp_indices[i],...,temp_indices[i+1]-1] will contain the scalars representing the constraint itself
1898674ae819SStefano Zampini                                                                                                                                                            */
1899674ae819SStefano Zampini     total_counts = n_ISForFaces+n_ISForEdges;
1900984c4197SStefano Zampini     total_counts *= max_constraints;
1901674ae819SStefano Zampini     n_vertices = 0;
1902674ae819SStefano Zampini     if (ISForVertices) {
1903674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
1904674ae819SStefano Zampini     }
1905674ae819SStefano Zampini     total_counts += n_vertices;
1906854ce69bSBarry Smith     ierr = PetscMalloc1(total_counts+1,&temp_indices);CHKERRQ(ierr);
19074641a718SStefano Zampini     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
1908674ae819SStefano Zampini     total_counts = 0;
1909674ae819SStefano Zampini     max_size_of_constraint = 0;
1910674ae819SStefano Zampini     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1911674ae819SStefano Zampini       if (i<n_ISForEdges) {
1912674ae819SStefano Zampini         used_IS = &ISForEdges[i];
1913674ae819SStefano Zampini       } else {
1914674ae819SStefano Zampini         used_IS = &ISForFaces[i-n_ISForEdges];
1915674ae819SStefano Zampini       }
1916674ae819SStefano Zampini       ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
1917674ae819SStefano Zampini       total_counts += j;
1918674ae819SStefano Zampini       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
1919674ae819SStefano Zampini     }
1920984c4197SStefano Zampini     total_counts *= max_constraints;
1921674ae819SStefano Zampini     total_counts += n_vertices;
1922906d46d4SStefano Zampini     ierr = PetscMalloc3(total_counts,&temp_quadrature_constraint,total_counts,&temp_indices_to_constraint,total_counts,&temp_indices_to_constraint_B);CHKERRQ(ierr);
1923984c4197SStefano Zampini     /* get local part of global near null space vectors */
1924785e854fSJed Brown     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
1925984c4197SStefano Zampini     for (k=0;k<nnsp_size;k++) {
1926984c4197SStefano Zampini       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
1927984c4197SStefano Zampini       ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1928984c4197SStefano Zampini       ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1929984c4197SStefano Zampini     }
1930674ae819SStefano Zampini 
1931242a89d7SStefano Zampini     /* whether or not to skip lapack calls */
1932242a89d7SStefano Zampini     skip_lapack = PETSC_TRUE;
1933a773dcb8SStefano Zampini     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
1934242a89d7SStefano Zampini 
1935984c4197SStefano Zampini     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
1936a773dcb8SStefano Zampini     if (!skip_lapack) {
1937674ae819SStefano Zampini       PetscScalar temp_work;
1938911cabfeSStefano Zampini 
1939674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1940984c4197SStefano Zampini       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
1941785e854fSJed Brown       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
1942785e854fSJed Brown       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
1943785e854fSJed Brown       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
1944674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1945785e854fSJed Brown       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
1946674ae819SStefano Zampini #endif
1947674ae819SStefano Zampini       /* now we evaluate the optimal workspace using query with lwork=-1 */
1948c8244a33SStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
1949c8244a33SStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
1950674ae819SStefano Zampini       lwork = -1;
1951674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1952674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1953c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
1954674ae819SStefano Zampini #else
1955c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
1956674ae819SStefano Zampini #endif
1957674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1958984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
1959674ae819SStefano Zampini #else /* on missing GESVD */
1960674ae819SStefano Zampini       /* SVD */
1961674ae819SStefano Zampini       PetscInt max_n,min_n;
1962674ae819SStefano Zampini       max_n = max_size_of_constraint;
1963984c4197SStefano Zampini       min_n = max_constraints;
1964984c4197SStefano Zampini       if (max_size_of_constraint < max_constraints) {
1965674ae819SStefano Zampini         min_n = max_size_of_constraint;
1966984c4197SStefano Zampini         max_n = max_constraints;
1967674ae819SStefano Zampini       }
1968785e854fSJed Brown       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
1969674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1970785e854fSJed Brown       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
1971674ae819SStefano Zampini #endif
1972674ae819SStefano Zampini       /* now we evaluate the optimal workspace using query with lwork=-1 */
1973674ae819SStefano Zampini       lwork = -1;
1974e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
1975e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
1976b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
1977674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1978674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1979cf5a6209SStefano Zampini       PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,&temp_quadrature_constraint[0],&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,&lierr));
1980674ae819SStefano Zampini #else
1981cf5a6209SStefano Zampini       PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,&temp_quadrature_constraint[0],&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,rwork,&lierr));
1982674ae819SStefano Zampini #endif
1983674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1984984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
1985984c4197SStefano Zampini #endif /* on missing GESVD */
1986674ae819SStefano Zampini       /* Allocate optimal workspace */
1987674ae819SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
1988854ce69bSBarry Smith       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
1989674ae819SStefano Zampini     }
1990674ae819SStefano Zampini     /* Now we can loop on constraining sets */
1991674ae819SStefano Zampini     total_counts = 0;
1992674ae819SStefano Zampini     temp_indices[0] = 0;
1993674ae819SStefano Zampini     /* vertices */
1994674ae819SStefano Zampini     if (ISForVertices) {
1995674ae819SStefano Zampini       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1996674ae819SStefano Zampini       if (nnsp_has_cnst) { /* consider all vertices */
199739e2fb2aSStefano Zampini         ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
1998674ae819SStefano Zampini         for (i=0;i<n_vertices;i++) {
1999674ae819SStefano Zampini           temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
2000674ae819SStefano Zampini           temp_indices[total_counts+1]=temp_indices[total_counts]+1;
2001674ae819SStefano Zampini           total_counts++;
2002674ae819SStefano Zampini         }
2003674ae819SStefano Zampini       } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
2004984c4197SStefano Zampini         PetscBool used_vertex;
2005674ae819SStefano Zampini         for (i=0;i<n_vertices;i++) {
2006674ae819SStefano Zampini           used_vertex = PETSC_FALSE;
2007674ae819SStefano Zampini           k = 0;
2008674ae819SStefano Zampini           while (!used_vertex && k<nnsp_size) {
2009984c4197SStefano Zampini             ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
2010984c4197SStefano Zampini             if (PetscAbsScalar(array[is_indices[i]])>0.0) {
2011674ae819SStefano Zampini               temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
2012674ae819SStefano Zampini               temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
2013674ae819SStefano Zampini               temp_indices[total_counts+1]=temp_indices[total_counts]+1;
2014674ae819SStefano Zampini               total_counts++;
2015674ae819SStefano Zampini               used_vertex = PETSC_TRUE;
2016674ae819SStefano Zampini             }
2017984c4197SStefano Zampini             ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
2018674ae819SStefano Zampini             k++;
2019674ae819SStefano Zampini           }
2020674ae819SStefano Zampini         }
2021674ae819SStefano Zampini       }
2022674ae819SStefano Zampini       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2023674ae819SStefano Zampini       n_vertices = total_counts;
2024674ae819SStefano Zampini     }
2025984c4197SStefano Zampini 
2026674ae819SStefano Zampini     /* edges and faces */
2027911cabfeSStefano Zampini     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
2028911cabfeSStefano Zampini       if (ncc<n_ISForEdges) {
2029911cabfeSStefano Zampini         used_IS = &ISForEdges[ncc];
2030984c4197SStefano Zampini         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
2031674ae819SStefano Zampini       } else {
2032911cabfeSStefano Zampini         used_IS = &ISForFaces[ncc-n_ISForEdges];
2033984c4197SStefano Zampini         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
2034674ae819SStefano Zampini       }
2035674ae819SStefano Zampini       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
2036674ae819SStefano Zampini       temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
2037674ae819SStefano Zampini       ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
2038674ae819SStefano Zampini       ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2039984c4197SStefano Zampini       /* change of basis should not be performed on local periodic nodes */
2040984c4197SStefano Zampini       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
2041674ae819SStefano Zampini       if (nnsp_has_cnst) {
20425b08dc53SStefano Zampini         PetscScalar quad_value;
2043674ae819SStefano Zampini         temp_constraints++;
2044a773dcb8SStefano Zampini         if (!pcbddc->use_nnsp_true) {
2045674ae819SStefano Zampini           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
2046a773dcb8SStefano Zampini         } else {
2047a773dcb8SStefano Zampini           quad_value = 1.0;
2048a773dcb8SStefano Zampini         }
204939e2fb2aSStefano Zampini         ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
2050674ae819SStefano Zampini         for (j=0;j<size_of_constraint;j++) {
2051674ae819SStefano Zampini           temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
2052674ae819SStefano Zampini         }
2053674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
2054674ae819SStefano Zampini         total_counts++;
2055674ae819SStefano Zampini       }
2056674ae819SStefano Zampini       for (k=0;k<nnsp_size;k++) {
2057984c4197SStefano Zampini         PetscReal real_value;
2058984c4197SStefano Zampini         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
205939e2fb2aSStefano Zampini         ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
2060674ae819SStefano Zampini         for (j=0;j<size_of_constraint;j++) {
2061984c4197SStefano Zampini           temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
2062674ae819SStefano Zampini         }
2063984c4197SStefano Zampini         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
2064984c4197SStefano Zampini         /* check if array is null on the connected component */
2065e310c8b4SStefano Zampini         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2066e310c8b4SStefano Zampini         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one));
20675b08dc53SStefano Zampini         if (real_value > 0.0) { /* keep indices and values */
2068674ae819SStefano Zampini           temp_constraints++;
2069674ae819SStefano Zampini           temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
2070674ae819SStefano Zampini           total_counts++;
2071674ae819SStefano Zampini         }
2072674ae819SStefano Zampini       }
2073674ae819SStefano Zampini       ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
207445a1bb75SStefano Zampini       valid_constraints = temp_constraints;
2075eb97c9d2SStefano Zampini       if (!pcbddc->use_nnsp_true && temp_constraints) {
2076a773dcb8SStefano Zampini         if (temp_constraints == 1) { /* just normalize the constraint */
2077a773dcb8SStefano Zampini           PetscScalar norm;
2078a773dcb8SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2079a773dcb8SStefano Zampini           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,temp_quadrature_constraint+temp_indices[temp_start_ptr],&Blas_one,temp_quadrature_constraint+temp_indices[temp_start_ptr],&Blas_one));
2080a773dcb8SStefano Zampini           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
2081a773dcb8SStefano Zampini           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,temp_quadrature_constraint+temp_indices[temp_start_ptr],&Blas_one));
2082a773dcb8SStefano Zampini         } else { /* perform SVD */
2083984c4197SStefano Zampini           PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
2084674ae819SStefano Zampini 
2085674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
2086984c4197SStefano Zampini           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
2087984c4197SStefano Zampini              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
2088984c4197SStefano Zampini              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
2089984c4197SStefano Zampini                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
2090984c4197SStefano Zampini                 from that computed using LAPACKgesvd
2091984c4197SStefano Zampini              -> This is due to a different computation of eigenvectors in LAPACKheev
2092984c4197SStefano Zampini              -> The quality of the POD-computed basis will be the same */
2093984c4197SStefano Zampini           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
2094674ae819SStefano Zampini           /* Store upper triangular part of correlation matrix */
2095e310c8b4SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2096984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2097674ae819SStefano Zampini           for (j=0;j<temp_constraints;j++) {
2098674ae819SStefano Zampini             for (k=0;k<j+1;k++) {
2099cf5a6209SStefano Zampini               PetscStackCallBLAS("BLASdot",correlation_mat[j*temp_constraints+k]=BLASdot_(&Blas_N,&temp_quadrature_constraint[temp_indices[temp_start_ptr+k]],&Blas_one,&temp_quadrature_constraint[temp_indices[temp_start_ptr+j]],&Blas_one));
2100674ae819SStefano Zampini             }
2101674ae819SStefano Zampini           }
2102e310c8b4SStefano Zampini           /* compute eigenvalues and eigenvectors of correlation matrix */
2103e310c8b4SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
2104e310c8b4SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
2105674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
2106c8244a33SStefano Zampini           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
2107674ae819SStefano Zampini #else
2108c8244a33SStefano Zampini           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
2109674ae819SStefano Zampini #endif
2110674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2111984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
2112984c4197SStefano Zampini           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
2113674ae819SStefano Zampini           j = 0;
2114984c4197SStefano Zampini           while (j < temp_constraints && singular_vals[j] < tol) j++;
2115674ae819SStefano Zampini           total_counts = total_counts-j;
211645a1bb75SStefano Zampini           valid_constraints = temp_constraints-j;
2117e310c8b4SStefano Zampini           /* scale and copy POD basis into used quadrature memory */
2118c4303822SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
2119c4303822SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
2120c4303822SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
2121c4303822SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2122c4303822SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
2123c4303822SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
2124674ae819SStefano Zampini           if (j<temp_constraints) {
2125984c4197SStefano Zampini             PetscInt ii;
2126984c4197SStefano Zampini             for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
2127674ae819SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2128c4303822SStefano Zampini             PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&Blas_M,&Blas_N,&Blas_K,&one,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Blas_LDA,correlation_mat,&Blas_LDB,&zero,temp_basis,&Blas_LDC));
2129674ae819SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
2130984c4197SStefano Zampini             for (k=0;k<temp_constraints-j;k++) {
2131674ae819SStefano Zampini               for (ii=0;ii<size_of_constraint;ii++) {
2132984c4197SStefano Zampini                 temp_quadrature_constraint[temp_indices[temp_start_ptr+k]+ii]=singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
2133674ae819SStefano Zampini               }
2134674ae819SStefano Zampini             }
2135674ae819SStefano Zampini           }
2136674ae819SStefano Zampini #else  /* on missing GESVD */
2137e310c8b4SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
2138e310c8b4SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
2139b7d8b9f8SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2140674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2141674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
2142cf5a6209SStefano Zampini           PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,work,&lwork,&lierr));
2143674ae819SStefano Zampini #else
2144cf5a6209SStefano Zampini           PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,&temp_quadrature_constraint[temp_indices[temp_start_ptr]],&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,work,&lwork,rwork,&lierr));
2145674ae819SStefano Zampini #endif
2146984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
2147674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2148984c4197SStefano Zampini           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
2149e310c8b4SStefano Zampini           k = temp_constraints;
2150e310c8b4SStefano Zampini           if (k > size_of_constraint) k = size_of_constraint;
2151674ae819SStefano Zampini           j = 0;
2152e310c8b4SStefano Zampini           while (j < k && singular_vals[k-j-1] < tol) j++;
215345a1bb75SStefano Zampini           valid_constraints = k-j;
2154911cabfeSStefano Zampini           total_counts = total_counts-temp_constraints+valid_constraints;
2155984c4197SStefano Zampini #endif /* on missing GESVD */
2156674ae819SStefano Zampini         }
2157a773dcb8SStefano Zampini       }
215845a1bb75SStefano Zampini       /* setting change_of_basis flag is safe now */
215945a1bb75SStefano Zampini       if (boolforchange) {
216045a1bb75SStefano Zampini         for (j=0;j<valid_constraints;j++) {
216145a1bb75SStefano Zampini           PetscBTSet(change_basis,total_counts-j-1);
216245a1bb75SStefano Zampini         }
216345a1bb75SStefano Zampini       }
2164674ae819SStefano Zampini     }
2165984c4197SStefano Zampini     /* free workspace */
21668f1c130eSStefano Zampini     if (!skip_lapack) {
2167984c4197SStefano Zampini       ierr = PetscFree(work);CHKERRQ(ierr);
2168984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
2169984c4197SStefano Zampini       ierr = PetscFree(rwork);CHKERRQ(ierr);
2170984c4197SStefano Zampini #endif
2171984c4197SStefano Zampini       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
2172984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
2173984c4197SStefano Zampini       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
2174984c4197SStefano Zampini       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
2175984c4197SStefano Zampini #endif
2176984c4197SStefano Zampini     }
2177984c4197SStefano Zampini     for (k=0;k<nnsp_size;k++) {
2178984c4197SStefano Zampini       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
2179984c4197SStefano Zampini     }
2180984c4197SStefano Zampini     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
2181cf5a6209SStefano Zampini     /* free index sets of faces, edges and vertices */
2182cf5a6209SStefano Zampini     for (i=0;i<n_ISForFaces;i++) {
2183cf5a6209SStefano Zampini       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
2184cf5a6209SStefano Zampini     }
2185cf5a6209SStefano Zampini     if (n_ISForFaces) {
2186cf5a6209SStefano Zampini       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
2187cf5a6209SStefano Zampini     }
2188cf5a6209SStefano Zampini     for (i=0;i<n_ISForEdges;i++) {
2189cf5a6209SStefano Zampini       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
2190cf5a6209SStefano Zampini     }
2191cf5a6209SStefano Zampini     if (n_ISForEdges) {
2192cf5a6209SStefano Zampini       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
2193cf5a6209SStefano Zampini     }
2194cf5a6209SStefano Zampini     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
219508122e43SStefano Zampini   } else {
219608122e43SStefano Zampini     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
219708122e43SStefano Zampini     PetscInt        cum = 0;
219808122e43SStefano Zampini 
219908122e43SStefano Zampini     total_counts = 0;
220008122e43SStefano Zampini     n_vertices = 0;
22018bec7fa6SStefano Zampini     if (sub_schurs->is_Ej_com && pcbddc->use_vertices) {
220208122e43SStefano Zampini       ierr = ISGetLocalSize(sub_schurs->is_Ej_com,&n_vertices);CHKERRQ(ierr);
220308122e43SStefano Zampini     }
220408122e43SStefano Zampini     max_constraints = 0;
220508122e43SStefano Zampini     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
220608122e43SStefano Zampini       total_counts += pcbddc->adaptive_constraints_n[i];
220708122e43SStefano Zampini       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
220808122e43SStefano Zampini     }
220908122e43SStefano Zampini     temp_indices = pcbddc->adaptive_constraints_ptrs;
221008122e43SStefano Zampini     temp_indices_to_constraint = pcbddc->adaptive_constraints_idxs;
221108122e43SStefano Zampini     temp_quadrature_constraint = pcbddc->adaptive_constraints_data;
221208122e43SStefano Zampini 
221308122e43SStefano Zampini #if 0
221408122e43SStefano Zampini     printf("Found %d totals\n",total_counts);
221508122e43SStefano Zampini     for (i=0;i<total_counts;i++) {
221608122e43SStefano Zampini       printf("const %d, start %d",i,temp_indices[i]);
221708122e43SStefano Zampini       printf(" end %d:\n",temp_indices[i+1]);
221808122e43SStefano Zampini       for (j=temp_indices[i];j<temp_indices[i+1];j++) {
221908122e43SStefano Zampini         printf("  idxs %d",temp_indices_to_constraint[j]);
222008122e43SStefano Zampini         printf("  data %1.2e\n",temp_quadrature_constraint[j]);
222108122e43SStefano Zampini       }
222208122e43SStefano Zampini     }
22231b968477SStefano Zampini     for (i=0;i<n_vertices;i++) {
22248bec7fa6SStefano Zampini       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
22251b968477SStefano Zampini     }
22261b968477SStefano Zampini     for (i=0;i<sub_schurs->n_subs;i++) {
22278bec7fa6SStefano Zampini       PetscPrintf(PETSC_COMM_SELF,"[%d] sub %d, edge %d, n %d\n",PetscGlobalRank,i,(PetscBool)PetscBTLookup(sub_schurs->is_edge,i),pcbddc->adaptive_constraints_n[i+n_vertices]);
22281b968477SStefano Zampini     }
222908122e43SStefano Zampini #endif
223008122e43SStefano Zampini 
22318bec7fa6SStefano Zampini     max_size_of_constraint = 0;
223208122e43SStefano Zampini     for (i=0;i<total_counts;i++) max_size_of_constraint = PetscMax(max_size_of_constraint,temp_indices[i+1]-temp_indices[i]);
223308122e43SStefano Zampini     ierr = PetscMalloc1(temp_indices[total_counts],&temp_indices_to_constraint_B);CHKERRQ(ierr);
223408122e43SStefano Zampini     /* Change of basis */
223508122e43SStefano Zampini     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
223608122e43SStefano Zampini     if (pcbddc->use_change_of_basis) {
2237bbb9e6c6SStefano Zampini       cum = n_vertices;
223808122e43SStefano Zampini       for (i=0;i<sub_schurs->n_subs;i++) {
223908122e43SStefano Zampini         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
2240bbb9e6c6SStefano Zampini           for (j=0;j<pcbddc->adaptive_constraints_n[i+n_vertices];j++) {
224108122e43SStefano Zampini             ierr = PetscBTSet(change_basis,cum+j);CHKERRQ(ierr);
224208122e43SStefano Zampini           }
224308122e43SStefano Zampini         }
2244bbb9e6c6SStefano Zampini         cum += pcbddc->adaptive_constraints_n[i+n_vertices];
224508122e43SStefano Zampini       }
224608122e43SStefano Zampini     }
224708122e43SStefano Zampini   }
224808122e43SStefano Zampini 
224908122e43SStefano Zampini   /* map temp_indices_to_constraint in boundary numbering */
225008122e43SStefano Zampini   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,temp_indices[total_counts],temp_indices_to_constraint,&i,temp_indices_to_constraint_B);CHKERRQ(ierr);
225108122e43SStefano Zampini   if (i != temp_indices[total_counts]) {
225208122e43SStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for constraints indices %d != %d\n",temp_indices[total_counts],i);
225308122e43SStefano Zampini   }
2254984c4197SStefano Zampini 
2255727cdba6SStefano Zampini   /* set quantities in pcbddc data structure and store previous primal size */
2256984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
2257674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
2258984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
2259674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
2260984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
2261674ae819SStefano Zampini 
2262674ae819SStefano Zampini   /* Create constraint matrix */
2263674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
226416f15bc4SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
2265984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
2266984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
226764efe560SStefano Zampini   ierr = PetscMalloc1(pcbddc->local_primal_size,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
22684641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n_B,&touched);CHKERRQ(ierr);
2269984c4197SStefano Zampini 
2270984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
2271984c4197SStefano Zampini   total_primal_vertices=0;
2272984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
2273674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
2274984c4197SStefano Zampini     if (size_of_constraint == 1) {
22754641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]]);CHKERRQ(ierr);
227664efe560SStefano Zampini       pcbddc->primal_indices_local_idxs[total_primal_vertices++]=temp_indices_to_constraint[temp_indices[i]];
227764efe560SStefano Zampini     } else if (PetscBTLookup(change_basis,i)) {
2278bc804489SStefano Zampini       /* find first (by global ordering) untouched node in the cc */
2279674ae819SStefano Zampini       k = 0;
22804641a718SStefano Zampini       while (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) k++;
2281bc804489SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+k]);CHKERRQ(ierr);
228264efe560SStefano Zampini       pcbddc->primal_indices_local_idxs[total_primal_vertices++]=temp_indices_to_constraint[temp_indices[i]+k];
2283984c4197SStefano Zampini     }
2284984c4197SStefano Zampini   }
228564efe560SStefano Zampini   pcbddc->n_actual_vertices = total_primal_vertices;
2286*70022509SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
2287*70022509SStefano Zampini   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
2288*70022509SStefano Zampini 
2289a717540cSStefano Zampini   /* determine if a QR strategy is needed for change of basis */
2290a717540cSStefano Zampini   qr_needed = PETSC_FALSE;
2291a717540cSStefano Zampini   ierr = PetscBTCreate(pcbddc->local_primal_size,&qr_needed_idx);CHKERRQ(ierr);
2292a717540cSStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
2293a717540cSStefano Zampini     if (PetscBTLookup(change_basis,i)) {
2294ac632422SStefano Zampini       if (!pcbddc->use_qr_single && !pcbddc->faster_deluxe) {
2295a717540cSStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
2296a717540cSStefano Zampini         j = 0;
2297a717540cSStefano Zampini         for (k=0;k<size_of_constraint;k++) {
2298a717540cSStefano Zampini           if (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) {
2299a717540cSStefano Zampini             j++;
2300a717540cSStefano Zampini           }
2301a717540cSStefano Zampini         }
2302a717540cSStefano Zampini         /* found more than one primal dof on the cc */
2303a717540cSStefano Zampini         if (j > 1) {
2304a717540cSStefano Zampini           PetscBTSet(qr_needed_idx,i);
2305a717540cSStefano Zampini           qr_needed = PETSC_TRUE;
2306a717540cSStefano Zampini         }
2307fa434743SStefano Zampini       } else {
2308fa434743SStefano Zampini         PetscBTSet(qr_needed_idx,i);
2309fa434743SStefano Zampini         qr_needed = PETSC_TRUE;
2310fa434743SStefano Zampini       }
2311a717540cSStefano Zampini     }
2312a717540cSStefano Zampini   }
2313*70022509SStefano Zampini 
2314*70022509SStefano Zampini   /* get reference dof for local constraints */
2315088faed8SStefano Zampini   total_counts = total_primal_vertices;
2316088faed8SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
2317088faed8SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
2318088faed8SStefano Zampini     if (size_of_constraint != 1 && !PetscBTLookup(change_basis,i)) {
2319bc804489SStefano Zampini       /* find first (by global ordering) untouched node in the cc */
2320088faed8SStefano Zampini       k = 0;
2321088faed8SStefano Zampini       while (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) k++;
2322bc804489SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+k]);CHKERRQ(ierr);
232364efe560SStefano Zampini       pcbddc->primal_indices_local_idxs[total_counts++]=temp_indices_to_constraint[temp_indices[i]+k];
2324088faed8SStefano Zampini     }
2325088faed8SStefano Zampini   }
232645a1bb75SStefano Zampini 
2327984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
2328785e854fSJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
2329984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
2330984c4197SStefano Zampini   j=total_primal_vertices;
2331984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
23324641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
2333674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
2334674ae819SStefano Zampini       j++;
2335674ae819SStefano Zampini     }
2336674ae819SStefano Zampini   }
2337674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
2338674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
2339088faed8SStefano Zampini 
2340674ae819SStefano Zampini   /* set values in constraint matrix */
2341984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
234264efe560SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
2343674ae819SStefano Zampini   }
2344984c4197SStefano Zampini   total_counts = total_primal_vertices;
2345984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
23464641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
2347674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
2348674ae819SStefano Zampini       ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&total_counts,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],&temp_quadrature_constraint[temp_indices[i]],INSERT_VALUES);CHKERRQ(ierr);
2349674ae819SStefano Zampini       total_counts++;
2350674ae819SStefano Zampini     }
2351674ae819SStefano Zampini   }
2352674ae819SStefano Zampini   /* assembling */
2353674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2354674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2355088faed8SStefano Zampini 
2356984c4197SStefano Zampini   /*
235745a1bb75SStefano Zampini   ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
2358984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
2359984c4197SStefano Zampini   */
2360674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
2361674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
2362026de310SStefano Zampini     /* dual and primal dofs on a single cc */
2363984c4197SStefano Zampini     PetscInt     dual_dofs,primal_dofs;
2364984c4197SStefano Zampini     /* working stuff for GEQRF */
236581d9aea3SBarry Smith     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
2366984c4197SStefano Zampini     PetscBLASInt lqr_work;
2367984c4197SStefano Zampini     /* working stuff for UNGQR */
2368984c4197SStefano Zampini     PetscScalar  *gqr_work,lgqr_work_t;
2369984c4197SStefano Zampini     PetscBLASInt lgqr_work;
2370984c4197SStefano Zampini     /* working stuff for TRTRS */
2371984c4197SStefano Zampini     PetscScalar  *trs_rhs;
23723f08241aSStefano Zampini     PetscBLASInt Blas_NRHS;
2373984c4197SStefano Zampini     /* pointers for values insertion into change of basis matrix */
2374984c4197SStefano Zampini     PetscInt     *start_rows,*start_cols;
2375984c4197SStefano Zampini     PetscScalar  *start_vals;
2376984c4197SStefano Zampini     /* working stuff for values insertion */
23774641a718SStefano Zampini     PetscBT      is_primal;
237864efe560SStefano Zampini     PetscInt     *aux_primal_numbering_B;
2379906d46d4SStefano Zampini     /* matrix sizes */
2380906d46d4SStefano Zampini     PetscInt     global_size,local_size;
2381906d46d4SStefano Zampini     /* temporary change of basis */
2382906d46d4SStefano Zampini     Mat          localChangeOfBasisMatrix;
2383cf5a6209SStefano Zampini     /* extra space for debugging */
2384cf5a6209SStefano Zampini     PetscScalar  *dbg_work;
2385984c4197SStefano Zampini 
2386906d46d4SStefano Zampini     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
2387906d46d4SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
238816f15bc4SStefano Zampini     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
2389bbb9e6c6SStefano Zampini     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
2390906d46d4SStefano Zampini     /* nonzeros for local mat */
2391bbb9e6c6SStefano Zampini     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
2392bbb9e6c6SStefano Zampini     for (i=0;i<pcis->n;i++) nnz[i]=1;
2393a717540cSStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
2394a717540cSStefano Zampini       if (PetscBTLookup(change_basis,i)) {
2395a717540cSStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
2396a717540cSStefano Zampini         if (PetscBTLookup(qr_needed_idx,i)) {
2397bbb9e6c6SStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint[temp_indices[i]+j]] = size_of_constraint;
2398a717540cSStefano Zampini         } else {
2399bbb9e6c6SStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint[temp_indices[i]+j]] = 2;
2400a717540cSStefano Zampini           /* get local primal index on the cc */
2401a717540cSStefano Zampini           j = 0;
2402a717540cSStefano Zampini           while (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+j])) j++;
2403bbb9e6c6SStefano Zampini           nnz[temp_indices_to_constraint[temp_indices[i]+j]] = size_of_constraint;
2404a717540cSStefano Zampini         }
2405a717540cSStefano Zampini       }
2406a717540cSStefano Zampini     }
2407906d46d4SStefano Zampini     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
2408bbb9e6c6SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
2409a717540cSStefano Zampini     /* Set initial identity in the matrix */
2410bbb9e6c6SStefano Zampini     for (i=0;i<pcis->n;i++) {
2411906d46d4SStefano Zampini       ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
2412a717540cSStefano Zampini     }
2413a717540cSStefano Zampini 
2414a717540cSStefano Zampini     if (pcbddc->dbg_flag) {
2415a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
2416a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
2417a717540cSStefano Zampini     }
2418a717540cSStefano Zampini 
2419a717540cSStefano Zampini 
2420a717540cSStefano Zampini     /* Now we loop on the constraints which need a change of basis */
2421a717540cSStefano Zampini     /*
2422a717540cSStefano Zampini        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
2423a717540cSStefano Zampini        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
2424a717540cSStefano Zampini 
2425a6b551f4SStefano Zampini        Basic blocks of change of basis matrix T computed by
2426a717540cSStefano Zampini 
2427a6b551f4SStefano Zampini           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
2428a6b551f4SStefano Zampini 
2429a6b551f4SStefano Zampini             | 1        0   ...        0         s_1/S |
2430a6b551f4SStefano Zampini             | 0        1   ...        0         s_2/S |
2431a717540cSStefano Zampini             |              ...                        |
2432a6b551f4SStefano Zampini             | 0        ...            1     s_{n-1}/S |
2433a6b551f4SStefano Zampini             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
2434a717540cSStefano Zampini 
2435a6b551f4SStefano Zampini             with S = \sum_{i=1}^n s_i^2
2436a6b551f4SStefano Zampini             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
2437a6b551f4SStefano Zampini                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
2438a6b551f4SStefano Zampini 
2439a6b551f4SStefano Zampini           - QR decomposition of constraints otherwise
2440a717540cSStefano Zampini     */
2441a717540cSStefano Zampini     if (qr_needed) {
2442984c4197SStefano Zampini       /* space to store Q */
2443854ce69bSBarry Smith       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
2444984c4197SStefano Zampini       /* first we issue queries for optimal work */
24453f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
24463f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
24473f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2448984c4197SStefano Zampini       lqr_work = -1;
24493f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
2450984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
2451984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
2452785e854fSJed Brown       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
2453984c4197SStefano Zampini       lgqr_work = -1;
24543f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
24553f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
24563f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
24573f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
24583f08241aSStefano Zampini       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
24593f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
2460984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
2461984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
2462785e854fSJed Brown       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
2463984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
2464785e854fSJed Brown       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
2465984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
2466785e854fSJed Brown       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
2467a717540cSStefano Zampini       /* allocating workspace for check */
2468a717540cSStefano Zampini       if (pcbddc->dbg_flag) {
2469cf5a6209SStefano Zampini         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
2470a717540cSStefano Zampini       }
2471a717540cSStefano Zampini     }
2472984c4197SStefano Zampini     /* array to store whether a node is primal or not */
24734641a718SStefano Zampini     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
2474473ba861SJed Brown     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
247564efe560SStefano Zampini     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->primal_indices_local_idxs,&i,aux_primal_numbering_B);CHKERRQ(ierr);
247639e2fb2aSStefano Zampini     if (i != total_primal_vertices) {
247739e2fb2aSStefano Zampini       SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",total_primal_vertices,i);
24784641a718SStefano Zampini     }
247939e2fb2aSStefano Zampini     for (i=0;i<total_primal_vertices;i++) {
248039e2fb2aSStefano Zampini       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
248139e2fb2aSStefano Zampini     }
248239e2fb2aSStefano Zampini     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
2483984c4197SStefano Zampini 
2484a717540cSStefano Zampini     /* loop on constraints and see whether or not they need a change of basis and compute it */
2485026de310SStefano Zampini     /* -> using implicit ordering contained in temp_indices data */
2486026de310SStefano Zampini     total_counts = pcbddc->n_vertices;
2487026de310SStefano Zampini     while (total_counts<pcbddc->local_primal_size) {
2488026de310SStefano Zampini       primal_dofs = 1;
24894641a718SStefano Zampini       if (PetscBTLookup(change_basis,total_counts)) {
2490026de310SStefano Zampini         /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
2491bbb9e6c6SStefano Zampini         while (total_counts+primal_dofs < pcbddc->local_primal_size && temp_indices_to_constraint[temp_indices[total_counts]] == temp_indices_to_constraint[temp_indices[total_counts+primal_dofs]]) {
2492026de310SStefano Zampini           primal_dofs++;
2493674ae819SStefano Zampini         }
2494984c4197SStefano Zampini         /* get constraint info */
2495026de310SStefano Zampini         size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
2496984c4197SStefano Zampini         dual_dofs = size_of_constraint-primal_dofs;
2497984c4197SStefano Zampini 
2498984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
2499a717540cSStefano Zampini           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraints %d to %d (incl) need a change of basis (size %d)\n",total_counts,total_counts+primal_dofs-1,size_of_constraint);CHKERRQ(ierr);
2500674ae819SStefano Zampini         }
2501984c4197SStefano Zampini 
2502fa434743SStefano Zampini         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
2503a717540cSStefano Zampini 
2504a717540cSStefano Zampini           /* copy quadrature constraints for change of basis check */
2505a717540cSStefano Zampini           if (pcbddc->dbg_flag) {
2506cf5a6209SStefano Zampini             ierr = PetscMemcpy(dbg_work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
2507a717540cSStefano Zampini           }
2508984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
2509026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
2510984c4197SStefano Zampini 
2511984c4197SStefano Zampini           /* compute QR decomposition of constraints */
25123f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
25133f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
25143f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2515674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
25163f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
2517984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
2518674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2519984c4197SStefano Zampini 
2520984c4197SStefano Zampini           /* explictly compute R^-T */
2521984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
2522984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
25233f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
25243f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
25253f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
25263f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
2527984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
25283f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
2529984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
2530984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2531984c4197SStefano Zampini 
2532a717540cSStefano Zampini           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
25333f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
25343f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
25353f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
25363f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2537984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
25383f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
2539984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
2540984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2541984c4197SStefano Zampini 
2542984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
2543984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
2544984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
25453f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
25463f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
25473f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
25483f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
25493f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
25503f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
2551984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2552c4303822SStefano Zampini           PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&Blas_M,&Blas_N,&Blas_K,&one,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&zero,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_LDC));
2553984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2554026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
2555984c4197SStefano Zampini 
2556984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
2557bbb9e6c6SStefano Zampini           start_rows = &temp_indices_to_constraint[temp_indices[total_counts]];
2558984c4197SStefano Zampini           /* insert cols for primal dofs */
2559984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
2560984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
2561bc804489SStefano Zampini             start_cols = &temp_indices_to_constraint[temp_indices[total_counts]+j];
2562906d46d4SStefano Zampini             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
2563984c4197SStefano Zampini           }
2564984c4197SStefano Zampini           /* insert cols for dual dofs */
2565984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
25664641a718SStefano Zampini             if (!PetscBTLookup(is_primal,temp_indices_to_constraint_B[temp_indices[total_counts]+k])) {
2567984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
2568bbb9e6c6SStefano Zampini               start_cols = &temp_indices_to_constraint[temp_indices[total_counts]+k];
2569906d46d4SStefano Zampini               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
2570984c4197SStefano Zampini               j++;
2571674ae819SStefano Zampini             }
2572674ae819SStefano Zampini           }
2573984c4197SStefano Zampini 
2574984c4197SStefano Zampini           /* check change of basis */
2575984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
2576984c4197SStefano Zampini             PetscInt   ii,jj;
2577984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
2578c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
2579c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2580c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
2581c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2582c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
2583c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
2584984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2585cf5a6209SStefano Zampini             PetscStackCallBLAS("BLASgemm",BLASgemm_("T","N",&Blas_M,&Blas_N,&Blas_K,&one,dbg_work,&Blas_LDA,qr_basis,&Blas_LDB,&zero,&dbg_work[size_of_constraint*primal_dofs],&Blas_LDC));
2586984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
2587984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
2588984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
2589cf5a6209SStefano Zampini                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
2590cf5a6209SStefano Zampini                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
2591674ae819SStefano Zampini               }
2592674ae819SStefano Zampini             }
2593984c4197SStefano Zampini             if (!valid_qr) {
259422d5777bSStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
2595984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
2596984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
2597cf5a6209SStefano Zampini                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
2598cf5a6209SStefano Zampini                     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\tQr basis function %d is not orthogonal to constraint %d (%1.14e)!\n",jj,ii,PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]));
2599674ae819SStefano Zampini                   }
2600cf5a6209SStefano Zampini                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
2601cf5a6209SStefano Zampini                     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\tQr basis function %d is not unitary w.r.t constraint %d (%1.14e)!\n",jj,ii,PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]));
2602984c4197SStefano Zampini                   }
2603984c4197SStefano Zampini                 }
2604984c4197SStefano Zampini               }
2605674ae819SStefano Zampini             } else {
260622d5777bSStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
2607674ae819SStefano Zampini             }
2608674ae819SStefano Zampini           }
2609a717540cSStefano Zampini         } else { /* simple transformation block */
2610a717540cSStefano Zampini           PetscInt    row,col;
2611a6b551f4SStefano Zampini           PetscScalar val,norm;
2612a6b551f4SStefano Zampini 
2613a6b551f4SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2614a6b551f4SStefano Zampini           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,temp_quadrature_constraint+temp_indices[total_counts],&Blas_one,temp_quadrature_constraint+temp_indices[total_counts],&Blas_one));
2615a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
2616bbb9e6c6SStefano Zampini             PetscInt row_B = temp_indices_to_constraint_B[temp_indices[total_counts]+j];
2617bbb9e6c6SStefano Zampini             row = temp_indices_to_constraint[temp_indices[total_counts]+j];
2618bbb9e6c6SStefano Zampini             if (!PetscBTLookup(is_primal,row_B)) {
2619bc804489SStefano Zampini               col = temp_indices_to_constraint[temp_indices[total_counts]];
2620906d46d4SStefano Zampini               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
2621a6b551f4SStefano Zampini               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,temp_quadrature_constraint[temp_indices[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
2622a717540cSStefano Zampini             } else {
2623a717540cSStefano Zampini               for (k=0;k<size_of_constraint;k++) {
2624bbb9e6c6SStefano Zampini                 col = temp_indices_to_constraint[temp_indices[total_counts]+k];
2625a717540cSStefano Zampini                 if (row != col) {
2626bc804489SStefano Zampini                   val = -temp_quadrature_constraint[temp_indices[total_counts]+k]/temp_quadrature_constraint[temp_indices[total_counts]];
2627a717540cSStefano Zampini                 } else {
2628bc804489SStefano Zampini                   val = temp_quadrature_constraint[temp_indices[total_counts]]/norm;
2629a717540cSStefano Zampini                 }
2630906d46d4SStefano Zampini                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
2631a717540cSStefano Zampini               }
2632a717540cSStefano Zampini             }
2633a717540cSStefano Zampini           }
263498a51de6SStefano Zampini           if (pcbddc->dbg_flag) {
263522d5777bSStefano Zampini             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
2636a717540cSStefano Zampini           }
2637674ae819SStefano Zampini         }
2638984c4197SStefano Zampini       } else {
2639984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
2640026de310SStefano Zampini           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,temp_indices[total_counts+1]-temp_indices[total_counts]);CHKERRQ(ierr);
2641674ae819SStefano Zampini         }
2642674ae819SStefano Zampini       }
2643026de310SStefano Zampini       /* increment constraint counter total_counts */
2644026de310SStefano Zampini       total_counts += primal_dofs;
2645674ae819SStefano Zampini     }
2646a717540cSStefano Zampini 
2647a717540cSStefano Zampini     /* free workspace */
2648a717540cSStefano Zampini     if (qr_needed) {
2649984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
2650cf5a6209SStefano Zampini         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
2651984c4197SStefano Zampini       }
2652984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
2653984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
2654984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
2655984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
2656984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
2657674ae819SStefano Zampini     }
2658a717540cSStefano Zampini     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
2659906d46d4SStefano Zampini     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2660906d46d4SStefano Zampini     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2661906d46d4SStefano Zampini 
2662906d46d4SStefano Zampini     /* assembling of global change of variable */
2663bbb9e6c6SStefano Zampini     {
2664bbb9e6c6SStefano Zampini       Mat      tmat;
266516f15bc4SStefano Zampini       PetscInt bs;
266616f15bc4SStefano Zampini 
2667906d46d4SStefano Zampini       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
2668906d46d4SStefano Zampini       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
2669bbb9e6c6SStefano Zampini       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
2670bbb9e6c6SStefano Zampini       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
2671bbb9e6c6SStefano Zampini       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
2672bbb9e6c6SStefano Zampini       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
267316f15bc4SStefano Zampini       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
267416f15bc4SStefano Zampini       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
2675906d46d4SStefano Zampini       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
2676bbb9e6c6SStefano Zampini       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
2677bbb9e6c6SStefano Zampini       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
2678bbb9e6c6SStefano Zampini       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
2679bbb9e6c6SStefano Zampini       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
2680bbb9e6c6SStefano Zampini       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
2681bbb9e6c6SStefano Zampini       ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2682bbb9e6c6SStefano Zampini       ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2683bbb9e6c6SStefano Zampini       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
2684bbb9e6c6SStefano Zampini       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
2685906d46d4SStefano Zampini     }
2686906d46d4SStefano Zampini     /* check */
2687906d46d4SStefano Zampini     if (pcbddc->dbg_flag) {
2688906d46d4SStefano Zampini       PetscReal error;
2689906d46d4SStefano Zampini       Vec       x,x_change;
2690906d46d4SStefano Zampini 
2691906d46d4SStefano Zampini       ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
2692906d46d4SStefano Zampini       ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
2693906d46d4SStefano Zampini       ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
2694906d46d4SStefano Zampini       ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
2695bbb9e6c6SStefano Zampini       ierr = VecScatterBegin(matis->ctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2696bbb9e6c6SStefano Zampini       ierr = VecScatterEnd(matis->ctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2697bbb9e6c6SStefano Zampini       ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
2698bbb9e6c6SStefano Zampini       ierr = VecScatterBegin(matis->ctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2699bbb9e6c6SStefano Zampini       ierr = VecScatterEnd(matis->ctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2700906d46d4SStefano Zampini       ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
2701906d46d4SStefano Zampini       ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
2702906d46d4SStefano Zampini       ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
2703906d46d4SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2704bbb9e6c6SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Error global vs local change: %1.6e\n",error);CHKERRQ(ierr);
2705906d46d4SStefano Zampini       ierr = VecDestroy(&x);CHKERRQ(ierr);
2706906d46d4SStefano Zampini       ierr = VecDestroy(&x_change);CHKERRQ(ierr);
2707906d46d4SStefano Zampini     }
2708b96c3477SStefano Zampini 
2709b96c3477SStefano Zampini     /* adapt sub_schurs computed (if any) */
2710b96c3477SStefano Zampini     if (pcbddc->use_deluxe_scaling) {
2711b96c3477SStefano Zampini       PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
2712b96c3477SStefano Zampini       if (sub_schurs->S_Ej_all) {
2713ac632422SStefano Zampini         Mat S_new,tmat;
2714bbb9e6c6SStefano Zampini         IS is_all_N;
2715bbb9e6c6SStefano Zampini 
2716bbb9e6c6SStefano Zampini         ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
2717d648f858SStefano Zampini         ierr = MatGetSubMatrixUnsorted(localChangeOfBasisMatrix,is_all_N,is_all_N,&tmat);CHKERRQ(ierr);
2718bbb9e6c6SStefano Zampini         ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
2719ac632422SStefano Zampini         ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
2720b96c3477SStefano Zampini         ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
2721ac632422SStefano Zampini         ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
2722ac632422SStefano Zampini         sub_schurs->S_Ej_all = S_new;
2723ac632422SStefano Zampini         ierr = MatDestroy(&S_new);CHKERRQ(ierr);
2724ac632422SStefano Zampini         if (sub_schurs->sum_S_Ej_all) {
2725ac632422SStefano Zampini           ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
2726b96c3477SStefano Zampini           ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
2727ac632422SStefano Zampini           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
2728ac632422SStefano Zampini           sub_schurs->sum_S_Ej_all = S_new;
2729ac632422SStefano Zampini           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
2730ac632422SStefano Zampini         }
2731b96c3477SStefano Zampini         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
2732b96c3477SStefano Zampini       }
2733b96c3477SStefano Zampini     }
2734906d46d4SStefano Zampini     ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
2735906d46d4SStefano Zampini   } else if (pcbddc->user_ChangeOfBasisMatrix) {
2736b9b85e73SStefano Zampini     ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
2737b9b85e73SStefano Zampini     pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
2738b9b85e73SStefano Zampini   }
2739906d46d4SStefano Zampini 
2740906d46d4SStefano Zampini   /* set up change of basis context */
2741906d46d4SStefano Zampini   if (pcbddc->ChangeOfBasisMatrix) {
2742906d46d4SStefano Zampini     PCBDDCChange_ctx change_ctx;
2743906d46d4SStefano Zampini 
2744906d46d4SStefano Zampini     if (!pcbddc->new_global_mat) {
2745906d46d4SStefano Zampini       PetscInt global_size,local_size;
2746906d46d4SStefano Zampini 
2747906d46d4SStefano Zampini       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
2748906d46d4SStefano Zampini       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
2749906d46d4SStefano Zampini       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->new_global_mat);CHKERRQ(ierr);
2750906d46d4SStefano Zampini       ierr = MatSetSizes(pcbddc->new_global_mat,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
2751906d46d4SStefano Zampini       ierr = MatSetType(pcbddc->new_global_mat,MATSHELL);CHKERRQ(ierr);
2752906d46d4SStefano Zampini       ierr = MatShellSetOperation(pcbddc->new_global_mat,MATOP_MULT,(void (*)(void))PCBDDCMatMult_Private);CHKERRQ(ierr);
2753906d46d4SStefano Zampini       ierr = MatShellSetOperation(pcbddc->new_global_mat,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCMatMultTranspose_Private);CHKERRQ(ierr);
2754906d46d4SStefano Zampini       ierr = PetscNew(&change_ctx);CHKERRQ(ierr);
2755906d46d4SStefano Zampini       ierr = MatShellSetContext(pcbddc->new_global_mat,change_ctx);CHKERRQ(ierr);
2756906d46d4SStefano Zampini     } else {
2757906d46d4SStefano Zampini       ierr = MatShellGetContext(pcbddc->new_global_mat,&change_ctx);CHKERRQ(ierr);
2758906d46d4SStefano Zampini       ierr = MatDestroy(&change_ctx->global_change);CHKERRQ(ierr);
2759906d46d4SStefano Zampini       ierr = VecDestroyVecs(2,&change_ctx->work);CHKERRQ(ierr);
2760906d46d4SStefano Zampini     }
2761906d46d4SStefano Zampini     if (!pcbddc->user_ChangeOfBasisMatrix) {
2762906d46d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
2763906d46d4SStefano Zampini       change_ctx->global_change = pcbddc->ChangeOfBasisMatrix;
2764906d46d4SStefano Zampini     } else {
2765906d46d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
2766906d46d4SStefano Zampini       change_ctx->global_change = pcbddc->user_ChangeOfBasisMatrix;
2767906d46d4SStefano Zampini     }
2768906d46d4SStefano Zampini     ierr = VecDuplicateVecs(pcis->vec1_global,2,&change_ctx->work);CHKERRQ(ierr);
2769906d46d4SStefano Zampini     ierr = MatSetUp(pcbddc->new_global_mat);CHKERRQ(ierr);
2770906d46d4SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->new_global_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2771906d46d4SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->new_global_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2772b9b85e73SStefano Zampini   }
2773a717540cSStefano Zampini 
2774727cdba6SStefano Zampini   /* check if a new primal space has been introduced */
2775727cdba6SStefano Zampini   pcbddc->new_primal_space_local = PETSC_TRUE;
2776727cdba6SStefano Zampini   if (olocal_primal_size == pcbddc->local_primal_size) {
2777727cdba6SStefano Zampini     ierr = PetscMemcmp(pcbddc->primal_indices_local_idxs,oprimal_indices_local_idxs,olocal_primal_size,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
2778c1c8e736SStefano Zampini     pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
2779727cdba6SStefano Zampini   }
2780088faed8SStefano Zampini   ierr = PetscFree(oprimal_indices_local_idxs);CHKERRQ(ierr);
2781727cdba6SStefano Zampini   /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
2782727cdba6SStefano Zampini   ierr = MPI_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2783727cdba6SStefano Zampini 
2784a717540cSStefano Zampini   /* flush dbg viewer */
2785b8ffe317SStefano Zampini   if (pcbddc->dbg_flag) {
2786b8ffe317SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2787b8ffe317SStefano Zampini   }
2788a717540cSStefano Zampini 
2789e310c8b4SStefano Zampini   /* free workspace */
2790a717540cSStefano Zampini   ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2791a717540cSStefano Zampini   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
27924641a718SStefano Zampini   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
279308122e43SStefano Zampini   if (!pcbddc->adaptive_selection) {
2794906d46d4SStefano Zampini     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
2795906d46d4SStefano Zampini     ierr = PetscFree3(temp_quadrature_constraint,temp_indices_to_constraint,temp_indices_to_constraint_B);CHKERRQ(ierr);
279608122e43SStefano Zampini   } else {
279708122e43SStefano Zampini     ierr = PetscFree4(pcbddc->adaptive_constraints_n,
279808122e43SStefano Zampini                       pcbddc->adaptive_constraints_ptrs,
279908122e43SStefano Zampini                       pcbddc->adaptive_constraints_idxs,
280008122e43SStefano Zampini                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
280108122e43SStefano Zampini     ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
280208122e43SStefano Zampini   }
2803674ae819SStefano Zampini   PetscFunctionReturn(0);
2804674ae819SStefano Zampini }
2805674ae819SStefano Zampini 
2806674ae819SStefano Zampini #undef __FUNCT__
2807674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
2808674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
2809674ae819SStefano Zampini {
2810674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
2811674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
2812674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
28137fb0e2dbSStefano Zampini   PetscInt    ierr,i,vertex_size,N;
2814674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
2815674ae819SStefano Zampini 
2816674ae819SStefano Zampini   PetscFunctionBegin;
28178e61c736SStefano Zampini   /* Reset previously computed graph */
28188e61c736SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
2819674ae819SStefano Zampini   /* Init local Graph struct */
28207fb0e2dbSStefano Zampini   ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
28217fb0e2dbSStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping,N);CHKERRQ(ierr);
2822674ae819SStefano Zampini 
2823575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
2824575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
2825575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
2826575ad6abSStefano Zampini   }
28279577ea80SStefano Zampini 
2828674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
28294d379d7bSStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
28304d379d7bSStefano Zampini     PetscInt  *xadj,*adjncy;
28314d379d7bSStefano Zampini     PetscInt  nvtxs;
2832e496cd5dSStefano Zampini     PetscBool flg_row=PETSC_FALSE;
2833674ae819SStefano Zampini 
28344d379d7bSStefano Zampini     if (pcbddc->use_local_adj) {
28352fffb893SStefano Zampini 
28362fffb893SStefano Zampini       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
28372fffb893SStefano Zampini       if (flg_row) {
28384d379d7bSStefano Zampini         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
2839b96c3477SStefano Zampini         pcbddc->computed_rowadj = PETSC_TRUE;
28402fffb893SStefano Zampini       }
28412fffb893SStefano Zampini       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
28429b28b941SStefano Zampini     } else if (pcbddc->current_level && pcis->n_B) { /* just compute subdomain's connected components for coarser levels when the local boundary is not empty */
28434d379d7bSStefano Zampini       IS                     is_dummy;
28444d379d7bSStefano Zampini       ISLocalToGlobalMapping l2gmap_dummy;
28454d379d7bSStefano Zampini       PetscInt               j,sum;
28464d379d7bSStefano Zampini       PetscInt               *cxadj,*cadjncy;
28474d379d7bSStefano Zampini       const PetscInt         *idxs;
28484d379d7bSStefano Zampini       PCBDDCGraph            graph;
28494d379d7bSStefano Zampini       PetscBT                is_on_boundary;
28504d379d7bSStefano Zampini 
28514d379d7bSStefano Zampini       ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n,0,1,&is_dummy);CHKERRQ(ierr);
28524d379d7bSStefano Zampini       ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
28534d379d7bSStefano Zampini       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
28544d379d7bSStefano Zampini       ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
28557fb0e2dbSStefano Zampini       ierr = PCBDDCGraphInit(graph,l2gmap_dummy,pcis->n);CHKERRQ(ierr);
28564d379d7bSStefano Zampini       ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2857e496cd5dSStefano Zampini       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2858e496cd5dSStefano Zampini       if (flg_row) {
28594d379d7bSStefano Zampini         graph->xadj = xadj;
28604d379d7bSStefano Zampini         graph->adjncy = adjncy;
2861e496cd5dSStefano Zampini       }
28624d379d7bSStefano Zampini       ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
28634d379d7bSStefano Zampini       ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2864e496cd5dSStefano Zampini       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
28654d379d7bSStefano Zampini 
28664d379d7bSStefano Zampini       if (pcbddc->dbg_flag) {
28679b28b941SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"[%d] Found %d subdomains (local size %d)\n",PetscGlobalRank,graph->ncc,pcis->n);CHKERRQ(ierr);
28684d379d7bSStefano Zampini         for (i=0;i<graph->ncc;i++) {
28694d379d7bSStefano Zampini           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"[%d] %d cc size %d\n",PetscGlobalRank,i,graph->cptr[i+1]-graph->cptr[i]);CHKERRQ(ierr);
28704d379d7bSStefano Zampini         }
28714d379d7bSStefano Zampini       }
28724d379d7bSStefano Zampini 
2873e496cd5dSStefano Zampini       ierr = PetscBTCreate(pcis->n,&is_on_boundary);CHKERRQ(ierr);
28744d379d7bSStefano Zampini       ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
28754d379d7bSStefano Zampini       for (i=0;i<pcis->n_B;i++) {
28764d379d7bSStefano Zampini         ierr = PetscBTSet(is_on_boundary,idxs[i]);CHKERRQ(ierr);
28774d379d7bSStefano Zampini       }
28784d379d7bSStefano Zampini       ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
28794d379d7bSStefano Zampini 
2880e496cd5dSStefano Zampini       ierr = PetscCalloc1(pcis->n+1,&cxadj);CHKERRQ(ierr);
28814d379d7bSStefano Zampini       sum = 0;
28824d379d7bSStefano Zampini       for (i=0;i<graph->ncc;i++) {
28834d379d7bSStefano Zampini         PetscInt sizecc = 0;
28844d379d7bSStefano Zampini         for (j=graph->cptr[i];j<graph->cptr[i+1];j++) {
28854d379d7bSStefano Zampini           if (PetscBTLookup(is_on_boundary,graph->queue[j])) {
28864d379d7bSStefano Zampini             sizecc++;
28874d379d7bSStefano Zampini           }
28884d379d7bSStefano Zampini         }
28894d379d7bSStefano Zampini         for (j=graph->cptr[i];j<graph->cptr[i+1];j++) {
28904d379d7bSStefano Zampini           if (PetscBTLookup(is_on_boundary,graph->queue[j])) {
28914d379d7bSStefano Zampini             cxadj[graph->queue[j]] = sizecc;
28924d379d7bSStefano Zampini           }
28934d379d7bSStefano Zampini         }
28944d379d7bSStefano Zampini         sum += sizecc*sizecc;
28954d379d7bSStefano Zampini       }
28964d379d7bSStefano Zampini       ierr = PetscMalloc1(sum,&cadjncy);CHKERRQ(ierr);
28974d379d7bSStefano Zampini       sum = 0;
2898e496cd5dSStefano Zampini       for (i=0;i<pcis->n;i++) {
28994d379d7bSStefano Zampini         PetscInt temp = cxadj[i];
29004d379d7bSStefano Zampini         cxadj[i] = sum;
29014d379d7bSStefano Zampini         sum += temp;
29024d379d7bSStefano Zampini       }
2903e496cd5dSStefano Zampini       cxadj[pcis->n] = sum;
29044d379d7bSStefano Zampini       for (i=0;i<graph->ncc;i++) {
29054d379d7bSStefano Zampini         for (j=graph->cptr[i];j<graph->cptr[i+1];j++) {
29064d379d7bSStefano Zampini           if (PetscBTLookup(is_on_boundary,graph->queue[j])) {
29074d379d7bSStefano Zampini             PetscInt k,sizecc = 0;
29084d379d7bSStefano Zampini             for (k=graph->cptr[i];k<graph->cptr[i+1];k++) {
29094d379d7bSStefano Zampini               if (PetscBTLookup(is_on_boundary,graph->queue[k])) {
29104d379d7bSStefano Zampini                 cadjncy[cxadj[graph->queue[j]]+sizecc]=graph->queue[k];
29114d379d7bSStefano Zampini                 sizecc++;
29124d379d7bSStefano Zampini               }
29134d379d7bSStefano Zampini             }
29144d379d7bSStefano Zampini           }
29154d379d7bSStefano Zampini         }
29164d379d7bSStefano Zampini       }
29179b28b941SStefano Zampini       if (sum) {
2918e496cd5dSStefano Zampini         ierr = PCBDDCSetLocalAdjacencyGraph(pc,pcis->n,cxadj,cadjncy,PETSC_OWN_POINTER);CHKERRQ(ierr);
29194d379d7bSStefano Zampini       } else {
29204d379d7bSStefano Zampini         ierr = PetscFree(cxadj);CHKERRQ(ierr);
29214d379d7bSStefano Zampini         ierr = PetscFree(cadjncy);CHKERRQ(ierr);
29224d379d7bSStefano Zampini       }
29234d379d7bSStefano Zampini       graph->xadj = 0;
29244d379d7bSStefano Zampini       graph->adjncy = 0;
29254d379d7bSStefano Zampini       ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
29264d379d7bSStefano Zampini       ierr = PetscBTDestroy(&is_on_boundary);CHKERRQ(ierr);
29274d379d7bSStefano Zampini     }
2928674ae819SStefano Zampini   }
29299b28b941SStefano Zampini   if (pcbddc->dbg_flag) {
29309b28b941SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
29319b28b941SStefano Zampini   }
2932674ae819SStefano Zampini 
293363602bcaSStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting or PCBDDCSetDofsSplittingLocal */
2934674ae819SStefano Zampini   vertex_size = 1;
293563602bcaSStefano Zampini   if (pcbddc->user_provided_isfordofs) {
293663602bcaSStefano Zampini     if (pcbddc->n_ISForDofs) { /* need to convert from global to local and remove references to global dofs splitting */
293795ecbf38SStefano Zampini       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
293863602bcaSStefano Zampini       for (i=0;i<pcbddc->n_ISForDofs;i++) {
2939a7dc3881SStefano Zampini         ierr = PCBDDCGlobalToLocal(matis->ctx,pcis->vec1_global,pcis->vec1_N,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
294063602bcaSStefano Zampini         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
2941674ae819SStefano Zampini       }
294263602bcaSStefano Zampini       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
294363602bcaSStefano Zampini       pcbddc->n_ISForDofs = 0;
294463602bcaSStefano Zampini       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
2945674ae819SStefano Zampini     }
294663602bcaSStefano Zampini     /* mat block size as vertex size (used for elasticity with rigid body modes as nearnullspace) */
2947674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
294863602bcaSStefano Zampini   } else {
294963602bcaSStefano Zampini     if (!pcbddc->n_ISForDofsLocal) { /* field split not present, create it in local ordering */
295063602bcaSStefano Zampini       ierr = MatGetBlockSize(pc->pmat,&pcbddc->n_ISForDofsLocal);CHKERRQ(ierr);
2951854ce69bSBarry Smith       ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
295263602bcaSStefano Zampini       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
295363602bcaSStefano Zampini         ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),pcis->n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
295463602bcaSStefano Zampini       }
295563602bcaSStefano Zampini     }
2956674ae819SStefano Zampini   }
2957674ae819SStefano Zampini 
2958674ae819SStefano Zampini   /* Setup of Graph */
2959785d1243SStefano Zampini   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) { /* need to convert from global to local */
2960a7dc3881SStefano Zampini     ierr = PCBDDCGlobalToLocal(matis->ctx,pcis->vec1_global,pcis->vec1_N,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
2961785d1243SStefano Zampini   }
2962785d1243SStefano Zampini   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) { /* need to convert from global to local */
2963a7dc3881SStefano Zampini     ierr = PCBDDCGlobalToLocal(matis->ctx,pcis->vec1_global,pcis->vec1_N,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
2964785d1243SStefano Zampini   }
2965302440fdSBarry Smith   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices);CHKERRQ(ierr);
2966674ae819SStefano Zampini 
2967674ae819SStefano Zampini   /* Graph's connected components analysis */
2968674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
2969674ae819SStefano Zampini 
2970674ae819SStefano Zampini   /* print some info to stdout */
2971674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
2972302440fdSBarry Smith     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);CHKERRQ(ierr);
2973674ae819SStefano Zampini   }
2974fb180af4SStefano Zampini 
2975fb180af4SStefano Zampini   /* mark topography has done */
2976fb180af4SStefano Zampini   pcbddc->recompute_topography = PETSC_FALSE;
2977674ae819SStefano Zampini   PetscFunctionReturn(0);
2978674ae819SStefano Zampini }
2979674ae819SStefano Zampini 
2980674ae819SStefano Zampini #undef __FUNCT__
2981674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
2982674ae819SStefano Zampini PetscErrorCode PCBDDCSubsetNumbering(MPI_Comm comm,ISLocalToGlobalMapping l2gmap, PetscInt n_local_dofs, PetscInt local_dofs[], PetscInt local_dofs_mult[], PetscInt* n_global_subset, PetscInt* global_numbering_subset[])
2983674ae819SStefano Zampini {
2984674ae819SStefano Zampini   Vec            local_vec,global_vec;
2985674ae819SStefano Zampini   IS             seqis,paris;
2986674ae819SStefano Zampini   VecScatter     scatter_ctx;
2987674ae819SStefano Zampini   PetscScalar    *array;
2988674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
2989674ae819SStefano Zampini   PetscScalar    globalsum;
2990674ae819SStefano Zampini   PetscInt       i,j,s;
299117ccb9bdSStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local,max_global;
299217ccb9bdSStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm;
299317ccb9bdSStefano Zampini   PetscInt       *dof_sizes,*dof_displs;
2994674ae819SStefano Zampini   PetscBool      first_found;
2995674ae819SStefano Zampini   PetscErrorCode ierr;
2996674ae819SStefano Zampini 
2997674ae819SStefano Zampini   PetscFunctionBegin;
2998674ae819SStefano Zampini   /* mpi buffers */
2999b9b85e73SStefano Zampini   ierr = MPI_Comm_size(comm,&size_prec_comm);CHKERRQ(ierr);
3000b9b85e73SStefano Zampini   ierr = MPI_Comm_rank(comm,&rank_prec_comm);CHKERRQ(ierr);
3001674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
300217ccb9bdSStefano Zampini   ierr = PetscMalloc2(j,&dof_sizes,j,&dof_displs);CHKERRQ(ierr);
3003674ae819SStefano Zampini   /* get maximum size of subset */
3004785e854fSJed Brown   ierr = PetscMalloc1(n_local_dofs,&temp_global_dofs);CHKERRQ(ierr);
3005674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
3006674ae819SStefano Zampini   max_local = 0;
3007b9b85e73SStefano Zampini   for (i=0;i<n_local_dofs;i++) {
3008674ae819SStefano Zampini     if (max_local < temp_global_dofs[i] ) {
3009674ae819SStefano Zampini       max_local = temp_global_dofs[i];
3010674ae819SStefano Zampini     }
3011674ae819SStefano Zampini   }
3012b9b85e73SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);CHKERRQ(ierr);
3013674ae819SStefano Zampini   max_global++;
3014674ae819SStefano Zampini   max_local = 0;
3015b9b85e73SStefano Zampini   for (i=0;i<n_local_dofs;i++) {
3016674ae819SStefano Zampini     if (max_local < local_dofs[i] ) {
3017674ae819SStefano Zampini       max_local = local_dofs[i];
3018674ae819SStefano Zampini     }
3019674ae819SStefano Zampini   }
3020674ae819SStefano Zampini   max_local++;
3021674ae819SStefano Zampini   /* allocate workspace */
3022674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
3023674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
3024674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
3025674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
3026674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
3027674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
3028674ae819SStefano Zampini   /* create scatter */
3029674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
3030674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
3031674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
3032674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
3033674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
3034674ae819SStefano Zampini   /* init array */
3035674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
3036674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
3037674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
3038674ae819SStefano Zampini   if (local_dofs_mult) {
3039674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
3040674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
3041674ae819SStefano Zampini     }
3042674ae819SStefano Zampini   } else {
3043674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
3044674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
3045674ae819SStefano Zampini     }
3046674ae819SStefano Zampini   }
3047674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
3048674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
3049674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3050674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3051674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
30525b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
3053674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
3054674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
3055674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
3056674ae819SStefano Zampini   nlocals = 0;
3057674ae819SStefano Zampini   first_index = -1;
3058674ae819SStefano Zampini   first_found = PETSC_FALSE;
3059674ae819SStefano Zampini   for (i=0;i<s;i++) {
3060b9b85e73SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.1) {
3061674ae819SStefano Zampini       first_found = PETSC_TRUE;
3062674ae819SStefano Zampini       first_index = i;
3063674ae819SStefano Zampini     }
30645b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
3065674ae819SStefano Zampini   }
3066674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
3067674ae819SStefano Zampini   if (!rank_prec_comm) {
3068674ae819SStefano Zampini     dof_displs[0]=0;
3069674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
3070674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
3071674ae819SStefano Zampini     }
3072674ae819SStefano Zampini   }
3073674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
3074674ae819SStefano Zampini   if (first_found) {
3075674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
3076674ae819SStefano Zampini     old_index = first_index;
3077674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
3078b9b85e73SStefano Zampini       if (PetscRealPart(array[i]) > 0.1) {
3079674ae819SStefano Zampini         array[i] += array[old_index];
3080674ae819SStefano Zampini         old_index = i;
3081674ae819SStefano Zampini       }
3082674ae819SStefano Zampini     }
3083674ae819SStefano Zampini   }
3084674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
3085674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
3086674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3087674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3088674ae819SStefano Zampini   /* get global ordering of local dofs */
30892b095fd8SStefano Zampini   ierr = VecGetArrayRead(local_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
3090674ae819SStefano Zampini   if (local_dofs_mult) {
3091674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
30925b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
3093674ae819SStefano Zampini     }
3094674ae819SStefano Zampini   } else {
3095674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
30965b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
3097674ae819SStefano Zampini     }
3098674ae819SStefano Zampini   }
30992b095fd8SStefano Zampini   ierr = VecRestoreArrayRead(local_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
3100674ae819SStefano Zampini   /* free workspace */
3101674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
3102674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
3103674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
310417ccb9bdSStefano Zampini   ierr = PetscFree2(dof_sizes,dof_displs);CHKERRQ(ierr);
3105674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
3106674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
3107674ae819SStefano Zampini   PetscFunctionReturn(0);
3108674ae819SStefano Zampini }
31099a7d3425SStefano Zampini 
31109a7d3425SStefano Zampini #undef __FUNCT__
31119a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
31129a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
31139a7d3425SStefano Zampini {
31149a7d3425SStefano Zampini   PetscInt       i,j;
31159a7d3425SStefano Zampini   PetscScalar    *alphas;
31169a7d3425SStefano Zampini   PetscErrorCode ierr;
31179a7d3425SStefano Zampini 
31189a7d3425SStefano Zampini   PetscFunctionBegin;
31199a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
3120785e854fSJed Brown   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
31219a7d3425SStefano Zampini   for (i=0;i<n;i++) {
31229a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
31239a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
31249a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
31259a7d3425SStefano Zampini   }
31269a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
31279a7d3425SStefano Zampini   PetscFunctionReturn(0);
31289a7d3425SStefano Zampini }
31299a7d3425SStefano Zampini 
3130e7931f94SStefano Zampini #undef __FUNCT__
313170cf5478SStefano Zampini #define __FUNCT__ "MatISGetSubassemblingPattern"
313228143c3dSStefano Zampini PetscErrorCode MatISGetSubassemblingPattern(Mat mat, PetscInt n_subdomains, PetscBool contiguous, IS* is_sends)
3133e7931f94SStefano Zampini {
3134e7931f94SStefano Zampini   Mat             subdomain_adj;
3135e7931f94SStefano Zampini   IS              new_ranks,ranks_send_to;
3136e7931f94SStefano Zampini   MatPartitioning partitioner;
3137e7931f94SStefano Zampini   Mat_IS          *matis;
3138e7931f94SStefano Zampini   PetscInt        n_neighs,*neighs,*n_shared,**shared;
3139e7931f94SStefano Zampini   PetscInt        prank;
3140e7931f94SStefano Zampini   PetscMPIInt     size,rank,color;
3141e7931f94SStefano Zampini   PetscInt        *xadj,*adjncy,*oldranks;
3142e7931f94SStefano Zampini   PetscInt        *adjncy_wgt,*v_wgt,*is_indices,*ranks_send_to_idx;
31433837a79fSStefano Zampini   PetscInt        i,local_size,threshold=0;
3144e7931f94SStefano Zampini   PetscErrorCode  ierr;
31452b510759SStefano Zampini   PetscBool       use_vwgt=PETSC_FALSE,use_square=PETSC_FALSE;
3146e7931f94SStefano Zampini   PetscSubcomm    subcomm;
3147a57a6d2fSStefano Zampini 
3148e7931f94SStefano Zampini   PetscFunctionBegin;
31492b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_square",&use_square,NULL);CHKERRQ(ierr);
31502b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
31512b510759SStefano Zampini   ierr = PetscOptionsGetInt(NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
3152e7931f94SStefano Zampini 
3153e7931f94SStefano Zampini   /* Get info on mapping */
3154e7931f94SStefano Zampini   matis = (Mat_IS*)(mat->data);
3155e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&local_size);CHKERRQ(ierr);
3156e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
3157e7931f94SStefano Zampini 
3158e7931f94SStefano Zampini   /* build local CSR graph of subdomains' connectivity */
3159785e854fSJed Brown   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
3160e7931f94SStefano Zampini   xadj[0] = 0;
3161e7931f94SStefano Zampini   xadj[1] = PetscMax(n_neighs-1,0);
3162785e854fSJed Brown   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
3163785e854fSJed Brown   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
3164e7931f94SStefano Zampini 
31652b510759SStefano Zampini   if (threshold) {
3166d023bfaeSStefano Zampini     PetscInt xadj_count = 0;
31672b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
3168d023bfaeSStefano Zampini       if (n_shared[i] > threshold) {
3169d023bfaeSStefano Zampini         adjncy[xadj_count] = neighs[i];
3170d023bfaeSStefano Zampini         adjncy_wgt[xadj_count] = n_shared[i];
3171d023bfaeSStefano Zampini         xadj_count++;
3172e7931f94SStefano Zampini       }
3173e7931f94SStefano Zampini     }
3174d023bfaeSStefano Zampini     xadj[1] = xadj_count;
3175c8587f34SStefano Zampini   } else {
3176e7931f94SStefano Zampini     if (xadj[1]) {
3177e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy,&neighs[1],xadj[1]*sizeof(*adjncy));CHKERRQ(ierr);
3178e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy_wgt,&n_shared[1],xadj[1]*sizeof(*adjncy_wgt));CHKERRQ(ierr);
3179c8587f34SStefano Zampini     }
3180e7931f94SStefano Zampini   }
3181e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingRestoreInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
3182e7931f94SStefano Zampini   if (use_square) {
3183e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
3184e7931f94SStefano Zampini       adjncy_wgt[i] = adjncy_wgt[i]*adjncy_wgt[i];
3185e7931f94SStefano Zampini     }
3186e7931f94SStefano Zampini   }
3187e7931f94SStefano Zampini   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
3188e7931f94SStefano Zampini 
31893837a79fSStefano Zampini   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
3190e7931f94SStefano Zampini 
3191e7931f94SStefano Zampini   /*
3192e7931f94SStefano Zampini     Restrict work on active processes only.
3193e7931f94SStefano Zampini   */
3194e7931f94SStefano Zampini   ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&subcomm);CHKERRQ(ierr);
3195e7931f94SStefano Zampini   ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
3196e7931f94SStefano Zampini   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
31972b510759SStefano Zampini   ierr = PetscMPIIntCast(!local_size,&color);CHKERRQ(ierr);
3198d3531aaaSJed Brown   ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
3199e7931f94SStefano Zampini   if (color) {
3200e7931f94SStefano Zampini     ierr = PetscFree(xadj);CHKERRQ(ierr);
3201e7931f94SStefano Zampini     ierr = PetscFree(adjncy);CHKERRQ(ierr);
3202e7931f94SStefano Zampini     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
3203c8587f34SStefano Zampini   } else {
320428143c3dSStefano Zampini     PetscInt coarsening_ratio;
3205306c2d5bSBarry Smith     ierr = MPI_Comm_size(PetscSubcommChild(subcomm),&size);CHKERRQ(ierr);
3206785e854fSJed Brown     ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
3207e7931f94SStefano Zampini     prank = rank;
3208306c2d5bSBarry Smith     ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,PetscSubcommChild(subcomm));CHKERRQ(ierr);
32098002ef2cSStefano Zampini     /*
3210e7931f94SStefano Zampini     for (i=0;i<size;i++) {
3211e7931f94SStefano Zampini       PetscPrintf(subcomm->comm,"oldranks[%d] = %d\n",i,oldranks[i]);
3212c8587f34SStefano Zampini     }
32138002ef2cSStefano Zampini     */
3214e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
3215e7931f94SStefano Zampini       ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
3216c8587f34SStefano Zampini     }
3217e7931f94SStefano Zampini     ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
3218306c2d5bSBarry Smith     ierr = MatCreateMPIAdj(PetscSubcommChild(subcomm),1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
321922b6e8a2SStefano Zampini     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
3220e7931f94SStefano Zampini 
3221e7931f94SStefano Zampini     /* Partition */
3222306c2d5bSBarry Smith     ierr = MatPartitioningCreate(PetscSubcommChild(subcomm),&partitioner);CHKERRQ(ierr);
3223e7931f94SStefano Zampini     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
3224e7931f94SStefano Zampini     if (use_vwgt) {
32253837a79fSStefano Zampini       ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
3226e7931f94SStefano Zampini       v_wgt[0] = local_size;
3227e7931f94SStefano Zampini       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
3228c8587f34SStefano Zampini     }
322928143c3dSStefano Zampini     n_subdomains = PetscMin((PetscInt)size,n_subdomains);
323028143c3dSStefano Zampini     coarsening_ratio = size/n_subdomains;
323128143c3dSStefano Zampini     ierr = MatPartitioningSetNParts(partitioner,n_subdomains);CHKERRQ(ierr);
3232e7931f94SStefano Zampini     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
3233e7931f94SStefano Zampini     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
323422b6e8a2SStefano Zampini     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
3235e7931f94SStefano Zampini 
3236e7931f94SStefano Zampini     ierr = ISGetIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
323728143c3dSStefano Zampini     if (contiguous) {
323828143c3dSStefano Zampini       ranks_send_to_idx[0] = oldranks[is_indices[0]]; /* contiguos set of processes */
323928143c3dSStefano Zampini     } else {
324084ba6060SStefano Zampini       ranks_send_to_idx[0] = coarsening_ratio*oldranks[is_indices[0]]; /* scattered set of processes */
324128143c3dSStefano Zampini     }
3242e7931f94SStefano Zampini     ierr = ISRestoreIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
3243e7931f94SStefano Zampini     /* clean up */
3244e7931f94SStefano Zampini     ierr = PetscFree(oldranks);CHKERRQ(ierr);
3245e7931f94SStefano Zampini     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
3246e7931f94SStefano Zampini     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
3247e7931f94SStefano Zampini     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
3248e7931f94SStefano Zampini   }
3249e7931f94SStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
3250e7931f94SStefano Zampini 
3251e7931f94SStefano Zampini   /* assemble parallel IS for sends */
3252e7931f94SStefano Zampini   i = 1;
3253e7931f94SStefano Zampini   if (color) i=0;
3254e7931f94SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,&ranks_send_to);CHKERRQ(ierr);
3255e7931f94SStefano Zampini 
3256e7931f94SStefano Zampini   /* get back IS */
3257e7931f94SStefano Zampini   *is_sends = ranks_send_to;
3258e7931f94SStefano Zampini   PetscFunctionReturn(0);
3259e7931f94SStefano Zampini }
3260e7931f94SStefano Zampini 
3261e7931f94SStefano Zampini typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
3262e7931f94SStefano Zampini 
3263e7931f94SStefano Zampini #undef __FUNCT__
3264e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble"
326528143c3dSStefano Zampini PetscErrorCode MatISSubassemble(Mat mat, IS is_sends, PetscInt n_subdomains, PetscBool restrict_comm, MatReuse reuse, Mat *mat_n, PetscInt nis, IS isarray[])
3266e7931f94SStefano Zampini {
326770cf5478SStefano Zampini   Mat                    local_mat;
3268e7931f94SStefano Zampini   Mat_IS                 *matis;
3269e7931f94SStefano Zampini   IS                     is_sends_internal;
32709d30be91SStefano Zampini   PetscInt               rows,cols,new_local_rows;
327128143c3dSStefano Zampini   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals;
32729d30be91SStefano Zampini   PetscBool              ismatis,isdense,newisdense,destroy_mat;
3273e7931f94SStefano Zampini   ISLocalToGlobalMapping l2gmap;
3274e7931f94SStefano Zampini   PetscInt*              l2gmap_indices;
3275e7931f94SStefano Zampini   const PetscInt*        is_indices;
3276e7931f94SStefano Zampini   MatType                new_local_type;
3277e7931f94SStefano Zampini   /* buffers */
3278e7931f94SStefano Zampini   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
327928143c3dSStefano Zampini   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
32809d30be91SStefano Zampini   PetscInt               *recv_buffer_idxs_local;
3281e7931f94SStefano Zampini   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
3282e7931f94SStefano Zampini   /* MPI */
328328143c3dSStefano Zampini   MPI_Comm               comm,comm_n;
328428143c3dSStefano Zampini   PetscSubcomm           subcomm;
3285e7931f94SStefano Zampini   PetscMPIInt            n_sends,n_recvs,commsize;
328628143c3dSStefano Zampini   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
328728143c3dSStefano Zampini   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
328828143c3dSStefano Zampini   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,source_dest;
328928143c3dSStefano Zampini   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals;
329028143c3dSStefano Zampini   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals;
3291e7931f94SStefano Zampini   PetscErrorCode         ierr;
3292e7931f94SStefano Zampini 
3293e7931f94SStefano Zampini   PetscFunctionBegin;
329428143c3dSStefano Zampini   /* TODO: add missing checks */
329528143c3dSStefano Zampini   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
329628143c3dSStefano Zampini   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
329728143c3dSStefano Zampini   PetscValidLogicalCollectiveEnum(mat,reuse,5);
329828143c3dSStefano Zampini   PetscValidLogicalCollectiveInt(mat,nis,7);
3299e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
330028143c3dSStefano Zampini   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",__FUNCT__);
3301e7931f94SStefano Zampini   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
3302e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
3303e7931f94SStefano Zampini   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
3304e7931f94SStefano Zampini   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
3305e7931f94SStefano Zampini   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
330628143c3dSStefano Zampini   if (reuse == MAT_REUSE_MATRIX && *mat_n) {
330770cf5478SStefano Zampini     PetscInt mrows,mcols,mnrows,mncols;
330870cf5478SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
330928143c3dSStefano Zampini     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
331070cf5478SStefano Zampini     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
331170cf5478SStefano Zampini     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
331270cf5478SStefano Zampini     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
331370cf5478SStefano Zampini     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
331470cf5478SStefano Zampini   }
3315e7931f94SStefano Zampini   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
3316e7931f94SStefano Zampini   PetscValidLogicalCollectiveInt(mat,bs,0);
3317e7931f94SStefano Zampini   /* prepare IS for sending if not provided */
3318e7931f94SStefano Zampini   if (!is_sends) {
331928143c3dSStefano Zampini     PetscBool pcontig = PETSC_TRUE;
332028143c3dSStefano Zampini     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
332128143c3dSStefano Zampini     ierr = MatISGetSubassemblingPattern(mat,n_subdomains,pcontig,&is_sends_internal);CHKERRQ(ierr);
3322c8587f34SStefano Zampini   } else {
3323e7931f94SStefano Zampini     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
3324e7931f94SStefano Zampini     is_sends_internal = is_sends;
3325c8587f34SStefano Zampini   }
3326e7931f94SStefano Zampini 
3327e7931f94SStefano Zampini   /* get pointer of MATIS data */
3328e7931f94SStefano Zampini   matis = (Mat_IS*)mat->data;
3329e7931f94SStefano Zampini 
3330e7931f94SStefano Zampini   /* get comm */
3331a316fed8SStefano Zampini   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
3332e7931f94SStefano Zampini 
3333e7931f94SStefano Zampini   /* compute number of sends */
3334e7931f94SStefano Zampini   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
3335e7931f94SStefano Zampini   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
3336e7931f94SStefano Zampini 
3337e7931f94SStefano Zampini   /* compute number of receives */
3338e7931f94SStefano Zampini   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
3339785e854fSJed Brown   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
3340e7931f94SStefano Zampini   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
3341e7931f94SStefano Zampini   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
3342e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
3343e7931f94SStefano Zampini   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
3344e7931f94SStefano Zampini   ierr = PetscFree(iflags);CHKERRQ(ierr);
3345e7931f94SStefano Zampini 
334628143c3dSStefano Zampini   /* restrict comm if requested */
334728143c3dSStefano Zampini   subcomm = 0;
334828143c3dSStefano Zampini   destroy_mat = PETSC_FALSE;
334928143c3dSStefano Zampini   if (restrict_comm) {
3350779c1cceSStefano Zampini     PetscMPIInt color,subcommsize;
3351779c1cceSStefano Zampini 
335228143c3dSStefano Zampini     color = 0;
3353779c1cceSStefano Zampini     if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm */
335428143c3dSStefano Zampini     ierr = MPI_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
335528143c3dSStefano Zampini     subcommsize = commsize - subcommsize;
335628143c3dSStefano Zampini     /* check if reuse has been requested */
335728143c3dSStefano Zampini     if (reuse == MAT_REUSE_MATRIX) {
335828143c3dSStefano Zampini       if (*mat_n) {
335928143c3dSStefano Zampini         PetscMPIInt subcommsize2;
336028143c3dSStefano Zampini         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
336128143c3dSStefano Zampini         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
336228143c3dSStefano Zampini         comm_n = PetscObjectComm((PetscObject)*mat_n);
336328143c3dSStefano Zampini       } else {
336428143c3dSStefano Zampini         comm_n = PETSC_COMM_SELF;
336528143c3dSStefano Zampini       }
336628143c3dSStefano Zampini     } else { /* MAT_INITIAL_MATRIX */
3367779c1cceSStefano Zampini       PetscMPIInt rank;
3368779c1cceSStefano Zampini 
3369779c1cceSStefano Zampini       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
337028143c3dSStefano Zampini       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
337128143c3dSStefano Zampini       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
337228143c3dSStefano Zampini       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
3373306c2d5bSBarry Smith       comm_n = PetscSubcommChild(subcomm);
337428143c3dSStefano Zampini     }
337528143c3dSStefano Zampini     /* flag to destroy *mat_n if not significative */
337628143c3dSStefano Zampini     if (color) destroy_mat = PETSC_TRUE;
337728143c3dSStefano Zampini   } else {
337828143c3dSStefano Zampini     comm_n = comm;
337928143c3dSStefano Zampini   }
338028143c3dSStefano Zampini 
3381e7931f94SStefano Zampini   /* prepare send/receive buffers */
3382785e854fSJed Brown   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
3383e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
3384785e854fSJed Brown   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
3385e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
338628143c3dSStefano Zampini   if (nis) {
3387854ce69bSBarry Smith     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
338828143c3dSStefano Zampini   }
3389e7931f94SStefano Zampini 
339028143c3dSStefano Zampini   /* Get data from local matrices */
3391e7931f94SStefano Zampini   if (!isdense) {
3392a26c9d0eSStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
3393e7931f94SStefano Zampini     /* TODO: See below some guidelines on how to prepare the local buffers */
3394e7931f94SStefano Zampini     /*
3395e7931f94SStefano Zampini        send_buffer_vals should contain the raw values of the local matrix
3396e7931f94SStefano Zampini        send_buffer_idxs should contain:
3397e7931f94SStefano Zampini        - MatType_PRIVATE type
3398e7931f94SStefano Zampini        - PetscInt        size_of_l2gmap
3399e7931f94SStefano Zampini        - PetscInt        global_row_indices[size_of_l2gmap]
3400e7931f94SStefano Zampini        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
3401e7931f94SStefano Zampini     */
3402e7931f94SStefano Zampini   } else {
3403e7931f94SStefano Zampini     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
3404e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&i);CHKERRQ(ierr);
3405854ce69bSBarry Smith     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
3406e7931f94SStefano Zampini     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
3407e7931f94SStefano Zampini     send_buffer_idxs[1] = i;
3408e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
3409e7931f94SStefano Zampini     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
3410e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingRestoreIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
3411e7931f94SStefano Zampini     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
3412e7931f94SStefano Zampini     for (i=0;i<n_sends;i++) {
3413e7931f94SStefano Zampini       ilengths_vals[is_indices[i]] = len*len;
3414e7931f94SStefano Zampini       ilengths_idxs[is_indices[i]] = len+2;
3415c8587f34SStefano Zampini     }
3416c8587f34SStefano Zampini   }
3417e7931f94SStefano Zampini   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
341828143c3dSStefano Zampini   /* additional is (if any) */
341928143c3dSStefano Zampini   if (nis) {
342028143c3dSStefano Zampini     PetscMPIInt psum;
342128143c3dSStefano Zampini     PetscInt j;
342228143c3dSStefano Zampini     for (j=0,psum=0;j<nis;j++) {
342328143c3dSStefano Zampini       PetscInt plen;
342428143c3dSStefano Zampini       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
342528143c3dSStefano Zampini       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
342628143c3dSStefano Zampini       psum += len+1; /* indices + lenght */
342728143c3dSStefano Zampini     }
3428854ce69bSBarry Smith     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
342928143c3dSStefano Zampini     for (j=0,psum=0;j<nis;j++) {
343028143c3dSStefano Zampini       PetscInt plen;
343128143c3dSStefano Zampini       const PetscInt *is_array_idxs;
343228143c3dSStefano Zampini       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
343328143c3dSStefano Zampini       send_buffer_idxs_is[psum] = plen;
343428143c3dSStefano Zampini       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
343528143c3dSStefano Zampini       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
343628143c3dSStefano Zampini       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
343728143c3dSStefano Zampini       psum += plen+1; /* indices + lenght */
343828143c3dSStefano Zampini     }
343928143c3dSStefano Zampini     for (i=0;i<n_sends;i++) {
344028143c3dSStefano Zampini       ilengths_idxs_is[is_indices[i]] = psum;
344128143c3dSStefano Zampini     }
344228143c3dSStefano Zampini     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
344328143c3dSStefano Zampini   }
344428143c3dSStefano Zampini 
3445e7931f94SStefano Zampini   buf_size_idxs = 0;
3446e7931f94SStefano Zampini   buf_size_vals = 0;
344728143c3dSStefano Zampini   buf_size_idxs_is = 0;
3448e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3449e7931f94SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
3450e7931f94SStefano Zampini     buf_size_vals += (PetscInt)olengths_vals[i];
345128143c3dSStefano Zampini     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
3452e7931f94SStefano Zampini   }
3453785e854fSJed Brown   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
3454785e854fSJed Brown   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
345595ecbf38SStefano Zampini   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
3456e7931f94SStefano Zampini 
3457e7931f94SStefano Zampini   /* get new tags for clean communications */
3458e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
3459e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
346028143c3dSStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
3461e7931f94SStefano Zampini 
3462e7931f94SStefano Zampini   /* allocate for requests */
3463785e854fSJed Brown   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
3464785e854fSJed Brown   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
346595ecbf38SStefano Zampini   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
3466785e854fSJed Brown   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
3467785e854fSJed Brown   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
346895ecbf38SStefano Zampini   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
3469e7931f94SStefano Zampini 
3470e7931f94SStefano Zampini   /* communications */
3471e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
3472e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
347328143c3dSStefano Zampini   ptr_idxs_is = recv_buffer_idxs_is;
3474e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3475e7931f94SStefano Zampini     source_dest = onodes[i];
3476e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
3477e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
3478e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3479e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
348028143c3dSStefano Zampini     if (nis) {
348128143c3dSStefano Zampini       ierr = MPI_Irecv(ptr_idxs_is,olengths_idxs_is[i],MPIU_INT,source_dest,tag_idxs_is,comm,&recv_req_idxs_is[i]);CHKERRQ(ierr);
348228143c3dSStefano Zampini       ptr_idxs_is += olengths_idxs_is[i];
348328143c3dSStefano Zampini     }
3484e7931f94SStefano Zampini   }
3485e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) {
3486e7931f94SStefano Zampini     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
3487e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
3488e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
348928143c3dSStefano Zampini     if (nis) {
349028143c3dSStefano Zampini       ierr = MPI_Isend(send_buffer_idxs_is,ilengths_idxs_is[source_dest],MPIU_INT,source_dest,tag_idxs_is,comm,&send_req_idxs_is[i]);CHKERRQ(ierr);
349128143c3dSStefano Zampini     }
3492e7931f94SStefano Zampini   }
3493e7931f94SStefano Zampini   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
3494e7931f94SStefano Zampini   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
3495e7931f94SStefano Zampini 
3496e7931f94SStefano Zampini   /* assemble new l2g map */
3497e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3498e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
34999d30be91SStefano Zampini   new_local_rows = 0;
3500e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
35019d30be91SStefano Zampini     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
3502e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3503e7931f94SStefano Zampini   }
35049d30be91SStefano Zampini   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
3505e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
35069d30be91SStefano Zampini   new_local_rows = 0;
3507e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
35089d30be91SStefano Zampini     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
35099d30be91SStefano Zampini     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
3510e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3511e7931f94SStefano Zampini   }
35129d30be91SStefano Zampini   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
35139d30be91SStefano Zampini   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
3514e7931f94SStefano Zampini   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
3515e7931f94SStefano Zampini 
3516e7931f94SStefano Zampini   /* infer new local matrix type from received local matrices type */
3517e7931f94SStefano Zampini   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
3518e7931f94SStefano Zampini   /* it also assumes that if the block size is set, than it is the same among all local matrices (see checks at the beginning of the function) */
3519e7931f94SStefano Zampini   if (n_recvs) {
352028143c3dSStefano Zampini     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
3521e7931f94SStefano Zampini     ptr_idxs = recv_buffer_idxs;
3522e7931f94SStefano Zampini     for (i=0;i<n_recvs;i++) {
3523e7931f94SStefano Zampini       if ((PetscInt)new_local_type_private != *ptr_idxs) {
3524e7931f94SStefano Zampini         new_local_type_private = MATAIJ_PRIVATE;
3525e7931f94SStefano Zampini         break;
3526e7931f94SStefano Zampini       }
3527e7931f94SStefano Zampini       ptr_idxs += olengths_idxs[i];
3528e7931f94SStefano Zampini     }
3529e7931f94SStefano Zampini     switch (new_local_type_private) {
353028143c3dSStefano Zampini       case MATDENSE_PRIVATE:
353128143c3dSStefano Zampini         if (n_recvs>1) { /* subassembling of dense matrices does not give a dense matrix! */
3532e7931f94SStefano Zampini           new_local_type = MATSEQAIJ;
3533e7931f94SStefano Zampini           bs = 1;
353428143c3dSStefano Zampini         } else { /* if I receive only 1 dense matrix */
353528143c3dSStefano Zampini           new_local_type = MATSEQDENSE;
353628143c3dSStefano Zampini           bs = 1;
353728143c3dSStefano Zampini         }
3538e7931f94SStefano Zampini         break;
3539e7931f94SStefano Zampini       case MATAIJ_PRIVATE:
3540e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
3541e7931f94SStefano Zampini         bs = 1;
3542e7931f94SStefano Zampini         break;
3543e7931f94SStefano Zampini       case MATBAIJ_PRIVATE:
3544e7931f94SStefano Zampini         new_local_type = MATSEQBAIJ;
3545e7931f94SStefano Zampini         break;
3546e7931f94SStefano Zampini       case MATSBAIJ_PRIVATE:
3547e7931f94SStefano Zampini         new_local_type = MATSEQSBAIJ;
3548e7931f94SStefano Zampini         break;
3549e7931f94SStefano Zampini       default:
35509d30be91SStefano Zampini         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,__FUNCT__);
3551e7931f94SStefano Zampini         break;
3552e7931f94SStefano Zampini     }
355328143c3dSStefano Zampini   } else { /* by default, new_local_type is seqdense */
355428143c3dSStefano Zampini     new_local_type = MATSEQDENSE;
355528143c3dSStefano Zampini     bs = 1;
3556e7931f94SStefano Zampini   }
3557e7931f94SStefano Zampini 
355870cf5478SStefano Zampini   /* create MATIS object if needed */
355970cf5478SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
3560e7931f94SStefano Zampini     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
356128143c3dSStefano Zampini     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,mat_n);CHKERRQ(ierr);
356270cf5478SStefano Zampini   } else {
356370cf5478SStefano Zampini     /* it also destroys the local matrices */
356470cf5478SStefano Zampini     ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
356570cf5478SStefano Zampini   }
356670cf5478SStefano Zampini   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
3567e7931f94SStefano Zampini   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
35689d30be91SStefano Zampini 
35699d30be91SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
35709d30be91SStefano Zampini 
35719d30be91SStefano Zampini   /* Global to local map of received indices */
35729d30be91SStefano Zampini   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
35739d30be91SStefano Zampini   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
35749d30be91SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
35759d30be91SStefano Zampini 
35769d30be91SStefano Zampini   /* restore attributes -> type of incoming data and its size */
35779d30be91SStefano Zampini   buf_size_idxs = 0;
35789d30be91SStefano Zampini   for (i=0;i<n_recvs;i++) {
35799d30be91SStefano Zampini     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
35809d30be91SStefano Zampini     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
35819d30be91SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
35829d30be91SStefano Zampini   }
35839d30be91SStefano Zampini   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
35849d30be91SStefano Zampini 
35859d30be91SStefano Zampini   /* set preallocation */
35869d30be91SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
35879d30be91SStefano Zampini   if (!newisdense) {
35889d30be91SStefano Zampini     PetscInt *new_local_nnz=0;
35899d30be91SStefano Zampini 
35909d30be91SStefano Zampini     ptr_vals = recv_buffer_vals;
35919d30be91SStefano Zampini     ptr_idxs = recv_buffer_idxs_local;
35929d30be91SStefano Zampini     if (n_recvs) {
35939d30be91SStefano Zampini       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
35949d30be91SStefano Zampini     }
35959d30be91SStefano Zampini     for (i=0;i<n_recvs;i++) {
35969d30be91SStefano Zampini       PetscInt j;
35979d30be91SStefano Zampini       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
35989d30be91SStefano Zampini         for (j=0;j<*(ptr_idxs+1);j++) {
35999d30be91SStefano Zampini           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
36009d30be91SStefano Zampini         }
36019d30be91SStefano Zampini       } else {
36029d30be91SStefano Zampini         /* TODO */
36039d30be91SStefano Zampini       }
36049d30be91SStefano Zampini       ptr_idxs += olengths_idxs[i];
36059d30be91SStefano Zampini     }
36069d30be91SStefano Zampini     if (new_local_nnz) {
36079d30be91SStefano Zampini       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
36089d30be91SStefano Zampini       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
36099d30be91SStefano Zampini       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
36109d30be91SStefano Zampini       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
36119d30be91SStefano Zampini       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
36129d30be91SStefano Zampini       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
36139d30be91SStefano Zampini     } else {
36149d30be91SStefano Zampini       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
36159d30be91SStefano Zampini     }
36169d30be91SStefano Zampini     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
36179d30be91SStefano Zampini   } else {
36189d30be91SStefano Zampini     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
36199d30be91SStefano Zampini   }
3620e7931f94SStefano Zampini 
3621e7931f94SStefano Zampini   /* set values */
3622e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
36239d30be91SStefano Zampini   ptr_idxs = recv_buffer_idxs_local;
3624e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3625e7931f94SStefano Zampini     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
3626e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
36279d30be91SStefano Zampini       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
3628e7931f94SStefano Zampini       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3629e7931f94SStefano Zampini       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3630e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
363128143c3dSStefano Zampini     } else {
363228143c3dSStefano Zampini       /* TODO */
3633e7931f94SStefano Zampini     }
3634e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3635e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
3636e7931f94SStefano Zampini   }
3637e7931f94SStefano Zampini   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3638e7931f94SStefano Zampini   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
363970cf5478SStefano Zampini   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
364070cf5478SStefano Zampini   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
36419d30be91SStefano Zampini   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
36429d30be91SStefano Zampini   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
3643e7931f94SStefano Zampini 
3644dfd14d43SStefano Zampini #if 0
364528143c3dSStefano Zampini   if (!restrict_comm) { /* check */
3646e7931f94SStefano Zampini     Vec       lvec,rvec;
3647e7931f94SStefano Zampini     PetscReal infty_error;
3648e7931f94SStefano Zampini 
36492a7a6963SBarry Smith     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
3650e7931f94SStefano Zampini     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
3651e7931f94SStefano Zampini     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
3652e7931f94SStefano Zampini     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
365370cf5478SStefano Zampini     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
3654e7931f94SStefano Zampini     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3655e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
3656e7931f94SStefano Zampini     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
3657e7931f94SStefano Zampini     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
3658e7931f94SStefano Zampini   }
365928143c3dSStefano Zampini #endif
3660e7931f94SStefano Zampini 
366128143c3dSStefano Zampini   /* assemble new additional is (if any) */
366228143c3dSStefano Zampini   if (nis) {
366328143c3dSStefano Zampini     PetscInt **temp_idxs,*count_is,j,psum;
366428143c3dSStefano Zampini 
366528143c3dSStefano Zampini     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3666854ce69bSBarry Smith     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
366728143c3dSStefano Zampini     ptr_idxs = recv_buffer_idxs_is;
366828143c3dSStefano Zampini     psum = 0;
366928143c3dSStefano Zampini     for (i=0;i<n_recvs;i++) {
367028143c3dSStefano Zampini       for (j=0;j<nis;j++) {
367128143c3dSStefano Zampini         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
367228143c3dSStefano Zampini         count_is[j] += plen; /* increment counting of buffer for j-th IS */
367328143c3dSStefano Zampini         psum += plen;
367428143c3dSStefano Zampini         ptr_idxs += plen+1; /* shift pointer to received data */
367528143c3dSStefano Zampini       }
367628143c3dSStefano Zampini     }
3677854ce69bSBarry Smith     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
3678854ce69bSBarry Smith     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
367928143c3dSStefano Zampini     for (i=1;i<nis;i++) {
368028143c3dSStefano Zampini       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
368128143c3dSStefano Zampini     }
368228143c3dSStefano Zampini     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
368328143c3dSStefano Zampini     ptr_idxs = recv_buffer_idxs_is;
368428143c3dSStefano Zampini     for (i=0;i<n_recvs;i++) {
368528143c3dSStefano Zampini       for (j=0;j<nis;j++) {
368628143c3dSStefano Zampini         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
368728143c3dSStefano Zampini         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
368828143c3dSStefano Zampini         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
368928143c3dSStefano Zampini         ptr_idxs += plen+1; /* shift pointer to received data */
369028143c3dSStefano Zampini       }
369128143c3dSStefano Zampini     }
369228143c3dSStefano Zampini     for (i=0;i<nis;i++) {
369328143c3dSStefano Zampini       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
369428143c3dSStefano Zampini       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
369528143c3dSStefano Zampini       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
369628143c3dSStefano Zampini     }
369728143c3dSStefano Zampini     ierr = PetscFree(count_is);CHKERRQ(ierr);
369828143c3dSStefano Zampini     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
369928143c3dSStefano Zampini     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
370028143c3dSStefano Zampini   }
3701e7931f94SStefano Zampini   /* free workspace */
370228143c3dSStefano Zampini   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
3703e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3704e7931f94SStefano Zampini   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
3705e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3706e7931f94SStefano Zampini   if (isdense) {
3707e7931f94SStefano Zampini     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
3708e7931f94SStefano Zampini     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
3709e7931f94SStefano Zampini   } else {
3710e7931f94SStefano Zampini     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
3711e7931f94SStefano Zampini   }
371228143c3dSStefano Zampini   if (nis) {
371328143c3dSStefano Zampini     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
371428143c3dSStefano Zampini     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
371528143c3dSStefano Zampini   }
3716e7931f94SStefano Zampini   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
3717e7931f94SStefano Zampini   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
371828143c3dSStefano Zampini   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
3719e7931f94SStefano Zampini   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
3720e7931f94SStefano Zampini   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
372128143c3dSStefano Zampini   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
3722e7931f94SStefano Zampini   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
3723e7931f94SStefano Zampini   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
3724e7931f94SStefano Zampini   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
3725e7931f94SStefano Zampini   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
3726e7931f94SStefano Zampini   ierr = PetscFree(onodes);CHKERRQ(ierr);
372728143c3dSStefano Zampini   if (nis) {
372828143c3dSStefano Zampini     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
372928143c3dSStefano Zampini     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
373028143c3dSStefano Zampini     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
373128143c3dSStefano Zampini   }
373228143c3dSStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
373328143c3dSStefano Zampini   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
373428143c3dSStefano Zampini     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
373528143c3dSStefano Zampini     for (i=0;i<nis;i++) {
373628143c3dSStefano Zampini       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
373728143c3dSStefano Zampini     }
373828143c3dSStefano Zampini   }
3739e7931f94SStefano Zampini   PetscFunctionReturn(0);
3740e7931f94SStefano Zampini }
3741a57a6d2fSStefano Zampini 
374212edc857SStefano Zampini /* temporary hack into ksp private data structure */
3743af0996ceSBarry Smith #include <petsc/private/kspimpl.h>
374412edc857SStefano Zampini 
3745c8587f34SStefano Zampini #undef __FUNCT__
3746c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
3747c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
3748c8587f34SStefano Zampini {
3749c8587f34SStefano Zampini   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
3750c8587f34SStefano Zampini   PC_IS                  *pcis = (PC_IS*)pc->data;
375120a2ab83SStefano Zampini   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
37529881197aSStefano Zampini   MatNullSpace           CoarseNullSpace=NULL;
375320a2ab83SStefano Zampini   ISLocalToGlobalMapping coarse_islg;
37546e683305SStefano Zampini   IS                     coarse_is,*isarray;
37556e683305SStefano Zampini   PetscInt               i,im_active=-1,active_procs=-1;
37566e683305SStefano Zampini   PetscInt               nis,nisdofs,nisneu;
3757f9eb5b7dSStefano Zampini   PC                     pc_temp;
3758c8587f34SStefano Zampini   PCType                 coarse_pc_type;
3759c8587f34SStefano Zampini   KSPType                coarse_ksp_type;
3760f9eb5b7dSStefano Zampini   PetscBool              multilevel_requested,multilevel_allowed;
37614f3a063dSStefano Zampini   PetscBool              isredundant,isbddc,isnn,coarse_reuse;
37626e683305SStefano Zampini   Mat                    t_coarse_mat_is;
37636e683305SStefano Zampini   PetscInt               void_procs,ncoarse_ml,ncoarse_ds,ncoarse;
37646e683305SStefano Zampini   PetscMPIInt            all_procs;
376574e2c79eSStefano Zampini   PetscBool              csin_ml,csin_ds,csin,csin_type_simple,redist;
376668457ee5SStefano Zampini   PetscBool              compute_vecs = PETSC_FALSE;
376722bc73bbSStefano Zampini   PetscScalar            *array;
37689881197aSStefano Zampini   PetscErrorCode         ierr;
3769fdc09c96SStefano Zampini 
3770c8587f34SStefano Zampini   PetscFunctionBegin;
3771c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
377268457ee5SStefano Zampini   if (pcbddc->new_primal_space || pcbddc->coarse_size == -1) { /* a new primal space is present or it is the first initialization, so recompute global numbering */
3773fa7f1dd8SStefano Zampini     PetscInt ocoarse_size;
37745a75c04eSSatish Balay     compute_vecs = PETSC_TRUE;
3775fa7f1dd8SStefano Zampini     ocoarse_size = pcbddc->coarse_size;
3776f4ddd8eeSStefano Zampini     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3777f4ddd8eeSStefano Zampini     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
3778f4ddd8eeSStefano Zampini     /* see if we can avoid some work */
3779fa7f1dd8SStefano Zampini     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
3780fa7f1dd8SStefano Zampini       if (ocoarse_size != pcbddc->coarse_size) { /* ...but with different size, so reset it and set reuse flag to false */
3781727cdba6SStefano Zampini         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3782fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_FALSE;
3783fa7f1dd8SStefano Zampini       } else { /* we can safely reuse already computed coarse matrix */
3784fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_TRUE;
3785f4ddd8eeSStefano Zampini       }
3786fa7f1dd8SStefano Zampini     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
3787fa7f1dd8SStefano Zampini       coarse_reuse = PETSC_FALSE;
3788f4ddd8eeSStefano Zampini     }
378970cf5478SStefano Zampini     /* reset any subassembling information */
379070cf5478SStefano Zampini     ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
37916e683305SStefano Zampini     ierr = ISDestroy(&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
37926e683305SStefano Zampini   } else { /* primal space is unchanged, so we can reuse coarse matrix */
3793fa7f1dd8SStefano Zampini     coarse_reuse = PETSC_TRUE;
3794f4ddd8eeSStefano Zampini   }
3795c8587f34SStefano Zampini 
37966e683305SStefano Zampini   /* count "active" (i.e. with positive local size) and "void" processes */
37972b510759SStefano Zampini   im_active = !!(pcis->n);
37982b510759SStefano Zampini   ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
37996e683305SStefano Zampini   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&all_procs);CHKERRQ(ierr);
38006e683305SStefano Zampini   void_procs = all_procs-active_procs;
38016e683305SStefano Zampini   csin_type_simple = PETSC_TRUE;
380274e2c79eSStefano Zampini   redist = PETSC_FALSE;
380322bc73bbSStefano Zampini   if (pcbddc->current_level && void_procs) {
38046e683305SStefano Zampini     csin_ml = PETSC_TRUE;
38056e683305SStefano Zampini     ncoarse_ml = void_procs;
3806779c1cceSStefano Zampini     /* it has no sense to redistribute on a set of processors larger than the number of active processes */
3807779c1cceSStefano Zampini     if (pcbddc->redistribute_coarse > 0 && pcbddc->redistribute_coarse < active_procs) {
380818a45a71SStefano Zampini       csin_ds = PETSC_TRUE;
380918a45a71SStefano Zampini       ncoarse_ds = pcbddc->redistribute_coarse;
381018a45a71SStefano Zampini       redist = PETSC_TRUE;
381118a45a71SStefano Zampini     } else {
38126e683305SStefano Zampini       csin_ds = PETSC_TRUE;
3813779c1cceSStefano Zampini       ncoarse_ds = active_procs;
3814779c1cceSStefano Zampini       redist = PETSC_TRUE;
381518a45a71SStefano Zampini     }
38166e683305SStefano Zampini   } else {
38176e683305SStefano Zampini     csin_ml = PETSC_FALSE;
38186e683305SStefano Zampini     ncoarse_ml = all_procs;
38196e683305SStefano Zampini     if (void_procs) {
38206e683305SStefano Zampini       csin_ds = PETSC_TRUE;
38216e683305SStefano Zampini       ncoarse_ds = void_procs;
38226e683305SStefano Zampini       csin_type_simple = PETSC_FALSE;
38236e683305SStefano Zampini     } else {
3824779c1cceSStefano Zampini       if (pcbddc->redistribute_coarse > 0 && pcbddc->redistribute_coarse < all_procs) {
382574e2c79eSStefano Zampini         csin_ds = PETSC_TRUE;
382674e2c79eSStefano Zampini         ncoarse_ds = pcbddc->redistribute_coarse;
382774e2c79eSStefano Zampini         redist = PETSC_TRUE;
382874e2c79eSStefano Zampini       } else {
38296e683305SStefano Zampini         csin_ds = PETSC_FALSE;
38306e683305SStefano Zampini         ncoarse_ds = all_procs;
38316e683305SStefano Zampini       }
38326e683305SStefano Zampini     }
383374e2c79eSStefano Zampini   }
38346e683305SStefano Zampini 
38356e683305SStefano Zampini   /*
38366e683305SStefano Zampini     test if we can go multilevel: three conditions must be satisfied:
38376e683305SStefano Zampini     - we have not exceeded the number of levels requested
38386e683305SStefano Zampini     - we can actually subassemble the active processes
38396e683305SStefano Zampini     - we can find a suitable number of MPI processes where we can place the subassembled problem
38406e683305SStefano Zampini   */
38416e683305SStefano Zampini   multilevel_allowed = PETSC_FALSE;
38426e683305SStefano Zampini   multilevel_requested = PETSC_FALSE;
38436e683305SStefano Zampini   if (pcbddc->current_level < pcbddc->max_levels) {
38446e683305SStefano Zampini     multilevel_requested = PETSC_TRUE;
38456e683305SStefano Zampini     if (active_procs/pcbddc->coarsening_ratio < 2 || ncoarse_ml/pcbddc->coarsening_ratio < 2) {
3846f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_FALSE;
38472b510759SStefano Zampini     } else {
3848f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_TRUE;
3849c8587f34SStefano Zampini     }
3850c8587f34SStefano Zampini   }
38516e683305SStefano Zampini   /* determine number of process partecipating to coarse solver */
38526e683305SStefano Zampini   if (multilevel_allowed) {
38536e683305SStefano Zampini     ncoarse = ncoarse_ml;
38546e683305SStefano Zampini     csin = csin_ml;
385558da7f69SStefano Zampini     redist = PETSC_FALSE;
38566e683305SStefano Zampini   } else {
38576e683305SStefano Zampini     ncoarse = ncoarse_ds;
38586e683305SStefano Zampini     csin = csin_ds;
38596e683305SStefano Zampini   }
3860e7931f94SStefano Zampini 
3861abbbba34SStefano Zampini   /* creates temporary l2gmap and IS for coarse indexes */
3862abbbba34SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
3863abbbba34SStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
3864abbbba34SStefano Zampini 
3865abbbba34SStefano Zampini   /* creates temporary MATIS object for coarse matrix */
386622bc73bbSStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
386722bc73bbSStefano Zampini   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
386822bc73bbSStefano Zampini   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
386922bc73bbSStefano Zampini   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
3870b9b85e73SStefano Zampini #if 0
3871b9b85e73SStefano Zampini   {
3872b9b85e73SStefano Zampini     PetscViewer viewer;
3873b9b85e73SStefano Zampini     char filename[256];
3874b9b85e73SStefano Zampini     sprintf(filename,"local_coarse_mat%d.m",PetscGlobalRank);
3875b9b85e73SStefano Zampini     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
3876b9b85e73SStefano Zampini     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
3877b9b85e73SStefano Zampini     ierr = MatView(coarse_submat_dense,viewer);CHKERRQ(ierr);
3878b9b85e73SStefano Zampini     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
3879b9b85e73SStefano Zampini   }
3880b9b85e73SStefano Zampini #endif
38816e683305SStefano Zampini   ierr = MatCreateIS(PetscObjectComm((PetscObject)pc),1,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size,coarse_islg,&t_coarse_mat_is);CHKERRQ(ierr);
38826e683305SStefano Zampini   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
38836e683305SStefano Zampini   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
38846e683305SStefano Zampini   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3885abbbba34SStefano Zampini   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
3886abbbba34SStefano Zampini 
38876e683305SStefano Zampini   /* compute dofs splitting and neumann boundaries for coarse dofs */
38886e683305SStefano Zampini   if (multilevel_allowed && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal) ) { /* protects from unneded computations */
38896e683305SStefano Zampini     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
38906e683305SStefano Zampini     const PetscInt         *idxs;
38916e683305SStefano Zampini     ISLocalToGlobalMapping tmap;
38926e683305SStefano Zampini 
38936e683305SStefano Zampini     /* create map between primal indices (in local representative ordering) and local primal numbering */
38940be93d54SStefano Zampini     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
38956e683305SStefano Zampini     /* allocate space for temporary storage */
3896854ce69bSBarry Smith     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
3897854ce69bSBarry Smith     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
38986e683305SStefano Zampini     /* allocate for IS array */
38996e683305SStefano Zampini     nisdofs = pcbddc->n_ISForDofsLocal;
39006e683305SStefano Zampini     nisneu = !!pcbddc->NeumannBoundariesLocal;
39016e683305SStefano Zampini     nis = nisdofs + nisneu;
3902854ce69bSBarry Smith     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
39036e683305SStefano Zampini     /* dofs splitting */
39046e683305SStefano Zampini     for (i=0;i<nisdofs;i++) {
39056e683305SStefano Zampini       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
39066e683305SStefano Zampini       ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
39076e683305SStefano Zampini       ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
39086e683305SStefano Zampini       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
39096e683305SStefano Zampini       ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
39106e683305SStefano Zampini       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
39116e683305SStefano Zampini       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pcbddc->ISForDofsLocal[i]),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
39126e683305SStefano Zampini       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
39136e683305SStefano Zampini     }
39146e683305SStefano Zampini     /* neumann boundaries */
39156e683305SStefano Zampini     if (pcbddc->NeumannBoundariesLocal) {
39166e683305SStefano Zampini       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
39176e683305SStefano Zampini       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
39186e683305SStefano Zampini       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
39196e683305SStefano Zampini       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
39206e683305SStefano Zampini       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
39216e683305SStefano Zampini       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
39226e683305SStefano Zampini       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pcbddc->NeumannBoundariesLocal),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
39236e683305SStefano Zampini       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
39246e683305SStefano Zampini     }
39256e683305SStefano Zampini     /* free memory */
39266e683305SStefano Zampini     ierr = PetscFree(tidxs);CHKERRQ(ierr);
39276e683305SStefano Zampini     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
39286e683305SStefano Zampini     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
39296e683305SStefano Zampini   } else {
39306e683305SStefano Zampini     nis = 0;
39316e683305SStefano Zampini     nisdofs = 0;
39326e683305SStefano Zampini     nisneu = 0;
39336e683305SStefano Zampini     isarray = NULL;
39346e683305SStefano Zampini   }
39356e683305SStefano Zampini   /* destroy no longer needed map */
39366e683305SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
39376e683305SStefano Zampini 
39386e683305SStefano Zampini   /* restrict on coarse candidates (if needed) */
39396e683305SStefano Zampini   coarse_mat_is = NULL;
39406e683305SStefano Zampini   if (csin) {
39416e683305SStefano Zampini     if (!pcbddc->coarse_subassembling_init ) { /* creates subassembling init pattern if not present */
394274e2c79eSStefano Zampini       if (redist) {
394374e2c79eSStefano Zampini         PetscMPIInt rank;
3944779c1cceSStefano Zampini         PetscInt    spc,n_spc_p1,dest[1],destsize;
394574e2c79eSStefano Zampini 
394674e2c79eSStefano Zampini         ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
394758da7f69SStefano Zampini         spc = active_procs/ncoarse;
394858da7f69SStefano Zampini         n_spc_p1 = active_procs%ncoarse;
3949779c1cceSStefano Zampini         if (im_active) {
3950779c1cceSStefano Zampini           destsize = 1;
395174e2c79eSStefano Zampini           if (rank > n_spc_p1*(spc+1)-1) {
395274e2c79eSStefano Zampini             dest[0] = n_spc_p1+(rank-(n_spc_p1*(spc+1)))/spc;
395374e2c79eSStefano Zampini           } else {
395474e2c79eSStefano Zampini             dest[0] = rank/(spc+1);
395574e2c79eSStefano Zampini           }
395674e2c79eSStefano Zampini         } else {
3957779c1cceSStefano Zampini           destsize = 0;
39586e683305SStefano Zampini         }
3959779c1cceSStefano Zampini         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),destsize,dest,PETSC_COPY_VALUES,&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
3960779c1cceSStefano Zampini       } else if (csin_type_simple) {
39616e683305SStefano Zampini         PetscMPIInt rank;
39626e683305SStefano Zampini         PetscInt    issize,isidx;
3963779c1cceSStefano Zampini 
39646e683305SStefano Zampini         ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
39656e683305SStefano Zampini         if (im_active) {
39666e683305SStefano Zampini           issize = 1;
39676e683305SStefano Zampini           isidx = (PetscInt)rank;
39686e683305SStefano Zampini         } else {
39696e683305SStefano Zampini           issize = 0;
39706e683305SStefano Zampini           isidx = -1;
39716e683305SStefano Zampini         }
39726e683305SStefano Zampini         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),issize,&isidx,PETSC_COPY_VALUES,&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
3973779c1cceSStefano Zampini       } else { /* get a suitable subassembling pattern from MATIS code */
39746e683305SStefano Zampini         ierr = MatISGetSubassemblingPattern(t_coarse_mat_is,ncoarse,PETSC_TRUE,&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
39756e683305SStefano Zampini       }
3976779c1cceSStefano Zampini 
3977779c1cceSStefano Zampini       /* we need to shift on coarse candidates either if we are not redistributing or we are redistributing and we have enough void processes */
3978779c1cceSStefano Zampini       if (!redist || ncoarse <= void_procs) {
3979779c1cceSStefano Zampini         PetscInt ncoarse_cand,tissize,*nisindices;
3980779c1cceSStefano Zampini         PetscInt *coarse_candidates;
3981779c1cceSStefano Zampini         const PetscInt* tisindices;
3982779c1cceSStefano Zampini 
3983779c1cceSStefano Zampini         /* get coarse candidates' ranks in pc communicator */
3984779c1cceSStefano Zampini         ierr = PetscMalloc1(all_procs,&coarse_candidates);CHKERRQ(ierr);
3985779c1cceSStefano Zampini         ierr = MPI_Allgather(&im_active,1,MPIU_INT,coarse_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3986779c1cceSStefano Zampini         for (i=0,ncoarse_cand=0;i<all_procs;i++) {
3987779c1cceSStefano Zampini           if (!coarse_candidates[i]) {
3988779c1cceSStefano Zampini             coarse_candidates[ncoarse_cand++]=i;
3989779c1cceSStefano Zampini           }
3990779c1cceSStefano Zampini         }
3991779c1cceSStefano Zampini         if (ncoarse_cand < ncoarse) SETERRQ2(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen! %d < %d",ncoarse_cand,ncoarse);
3992779c1cceSStefano Zampini 
3993779c1cceSStefano Zampini 
39946e683305SStefano Zampini         if (pcbddc->dbg_flag) {
39956e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
39966e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Subassembling pattern init (before shift)\n");CHKERRQ(ierr);
39976e683305SStefano Zampini           ierr = ISView(pcbddc->coarse_subassembling_init,pcbddc->dbg_viewer);CHKERRQ(ierr);
39986e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse candidates\n");CHKERRQ(ierr);
3999779c1cceSStefano Zampini           for (i=0;i<ncoarse_cand;i++) {
40006e683305SStefano Zampini             ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"%d ",coarse_candidates[i]);CHKERRQ(ierr);
40016e683305SStefano Zampini           }
40026e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"\n");CHKERRQ(ierr);
40036e683305SStefano Zampini           ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
40046e683305SStefano Zampini         }
40056e683305SStefano Zampini         /* shift the pattern on coarse candidates */
40066e683305SStefano Zampini         ierr = ISGetLocalSize(pcbddc->coarse_subassembling_init,&tissize);CHKERRQ(ierr);
40076e683305SStefano Zampini         ierr = ISGetIndices(pcbddc->coarse_subassembling_init,&tisindices);CHKERRQ(ierr);
4008854ce69bSBarry Smith         ierr = PetscMalloc1(tissize,&nisindices);CHKERRQ(ierr);
40096e683305SStefano Zampini         for (i=0;i<tissize;i++) nisindices[i] = coarse_candidates[tisindices[i]];
40106e683305SStefano Zampini         ierr = ISRestoreIndices(pcbddc->coarse_subassembling_init,&tisindices);CHKERRQ(ierr);
40116e683305SStefano Zampini         ierr = ISGeneralSetIndices(pcbddc->coarse_subassembling_init,tissize,nisindices,PETSC_OWN_POINTER);CHKERRQ(ierr);
40126e683305SStefano Zampini         ierr = PetscFree(coarse_candidates);CHKERRQ(ierr);
40136e683305SStefano Zampini       }
40146e683305SStefano Zampini       if (pcbddc->dbg_flag) {
40156e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
40166e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Subassembling pattern init\n");CHKERRQ(ierr);
40176e683305SStefano Zampini         ierr = ISView(pcbddc->coarse_subassembling_init,pcbddc->dbg_viewer);CHKERRQ(ierr);
40186e683305SStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
40196e683305SStefano Zampini       }
4020779c1cceSStefano Zampini     }
40216e683305SStefano Zampini     /* get temporary coarse mat in IS format restricted on coarse procs (plus additional index sets of isarray) */
40226e683305SStefano Zampini     ierr = MatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling_init,0,PETSC_TRUE,MAT_INITIAL_MATRIX,&coarse_mat_is,nis,isarray);CHKERRQ(ierr);
40236e683305SStefano Zampini   } else {
40246e683305SStefano Zampini     if (pcbddc->dbg_flag) {
40256e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
40266e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Subassembling pattern init not needed\n");CHKERRQ(ierr);
40276e683305SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
40286e683305SStefano Zampini     }
40296e683305SStefano Zampini     ierr = PetscObjectReference((PetscObject)t_coarse_mat_is);CHKERRQ(ierr);
40306e683305SStefano Zampini     coarse_mat_is = t_coarse_mat_is;
40316e683305SStefano Zampini   }
40326e683305SStefano Zampini 
40336e683305SStefano Zampini   /* create local to global scatters for coarse problem */
403468457ee5SStefano Zampini   if (compute_vecs) {
40356e683305SStefano Zampini     PetscInt lrows;
40366e683305SStefano Zampini     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
40376e683305SStefano Zampini     if (coarse_mat_is) {
40386e683305SStefano Zampini       ierr = MatGetLocalSize(coarse_mat_is,&lrows,NULL);CHKERRQ(ierr);
40396e683305SStefano Zampini     } else {
40406e683305SStefano Zampini       lrows = 0;
40416e683305SStefano Zampini     }
40426e683305SStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
40436e683305SStefano Zampini     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
40446e683305SStefano Zampini     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
40456e683305SStefano Zampini     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
40466e683305SStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
40476e683305SStefano Zampini   }
40486e683305SStefano Zampini   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
40496e683305SStefano Zampini   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
4050c8587f34SStefano Zampini 
4051f9eb5b7dSStefano Zampini   /* set defaults for coarse KSP and PC */
4052f9eb5b7dSStefano Zampini   if (multilevel_allowed) {
4053f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPRICHARDSON;
4054f9eb5b7dSStefano Zampini     coarse_pc_type = PCBDDC;
4055f9eb5b7dSStefano Zampini   } else {
4056f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPPREONLY;
4057f9eb5b7dSStefano Zampini     coarse_pc_type = PCREDUNDANT;
4058c8587f34SStefano Zampini   }
4059c8587f34SStefano Zampini 
40606e683305SStefano Zampini   /* print some info if requested */
40616e683305SStefano Zampini   if (pcbddc->dbg_flag) {
40626e683305SStefano Zampini     if (!multilevel_allowed) {
40636e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
40646e683305SStefano Zampini       if (multilevel_requested) {
40656e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Not enough active processes on level %d (active processes %d, coarsening ratio %d)\n",pcbddc->current_level,active_procs,pcbddc->coarsening_ratio);CHKERRQ(ierr);
40666e683305SStefano Zampini       } else if (pcbddc->max_levels) {
40676e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
40686e683305SStefano Zampini       }
40696e683305SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
40706e683305SStefano Zampini     }
40716e683305SStefano Zampini   }
40726e683305SStefano Zampini 
4073f9eb5b7dSStefano Zampini   /* create the coarse KSP object only once with defaults */
40746e683305SStefano Zampini   if (coarse_mat_is) {
40756e683305SStefano Zampini     MatReuse coarse_mat_reuse;
40766a1308c2SStefano Zampini     PetscViewer dbg_viewer = NULL;
40776e683305SStefano Zampini     if (pcbddc->dbg_flag) {
40786e683305SStefano Zampini       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat_is));
40796e683305SStefano Zampini       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
40806e683305SStefano Zampini     }
4081f9eb5b7dSStefano Zampini     if (!pcbddc->coarse_ksp) {
4082312be037SStefano Zampini       char prefix[256],str_level[16];
4083e604994aSStefano Zampini       size_t len;
40846e683305SStefano Zampini       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat_is),&pcbddc->coarse_ksp);CHKERRQ(ierr);
4085c8587f34SStefano Zampini       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
4086f9eb5b7dSStefano Zampini       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
40875f76c7aeSStefano Zampini       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat_is,coarse_mat_is);CHKERRQ(ierr);
4088c8587f34SStefano Zampini       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
40896e683305SStefano Zampini       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
4090c8587f34SStefano Zampini       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
4091c8587f34SStefano Zampini       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
40923e3c6dadSStefano Zampini       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4093e604994aSStefano Zampini       /* prefix */
4094e604994aSStefano Zampini       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
4095e604994aSStefano Zampini       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
4096e604994aSStefano Zampini       if (!pcbddc->current_level) {
4097e604994aSStefano Zampini         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4098e604994aSStefano Zampini         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
4099c8587f34SStefano Zampini       } else {
4100e604994aSStefano Zampini         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
4101312be037SStefano Zampini         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
4102312be037SStefano Zampini         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
410334d6797cSStefano Zampini         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4104312be037SStefano Zampini         sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
4105e604994aSStefano Zampini         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
4106e604994aSStefano Zampini       }
4107e604994aSStefano Zampini       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
41083e3c6dadSStefano Zampini       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
41093e3c6dadSStefano Zampini       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
41103e3c6dadSStefano Zampini       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
41113e3c6dadSStefano Zampini       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
4112f9eb5b7dSStefano Zampini       /* allow user customization */
4113f9eb5b7dSStefano Zampini       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
41143e3c6dadSStefano Zampini     }
41153e3c6dadSStefano Zampini     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
41163e3c6dadSStefano Zampini     if (nisdofs) {
41173e3c6dadSStefano Zampini       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
41183e3c6dadSStefano Zampini       for (i=0;i<nisdofs;i++) {
41193e3c6dadSStefano Zampini         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
41203e3c6dadSStefano Zampini       }
41213e3c6dadSStefano Zampini     }
41223e3c6dadSStefano Zampini     if (nisneu) {
41233e3c6dadSStefano Zampini       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
41243e3c6dadSStefano Zampini       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
4125312be037SStefano Zampini     }
4126f9eb5b7dSStefano Zampini 
4127f9eb5b7dSStefano Zampini     /* get some info after set from options */
4128f9eb5b7dSStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
4129f9eb5b7dSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
4130f9eb5b7dSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
41314f3a063dSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
41326e683305SStefano Zampini     if (isbddc && !multilevel_allowed) { /* multilevel can only be requested via pc_bddc_set_levels */
4133f9eb5b7dSStefano Zampini       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
4134f9eb5b7dSStefano Zampini       isbddc = PETSC_FALSE;
4135f9eb5b7dSStefano Zampini     }
41364f3a063dSStefano Zampini     if (isredundant) {
41374f3a063dSStefano Zampini       KSP inner_ksp;
41384f3a063dSStefano Zampini       PC inner_pc;
41394f3a063dSStefano Zampini       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
41404f3a063dSStefano Zampini       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
41414f3a063dSStefano Zampini       ierr = PCFactorSetReuseFill(inner_pc,PETSC_TRUE);CHKERRQ(ierr);
41424f3a063dSStefano Zampini     }
4143f9eb5b7dSStefano Zampini 
4144f9eb5b7dSStefano Zampini     /* assemble coarse matrix */
4145fa7f1dd8SStefano Zampini     if (coarse_reuse) {
414681d9aea3SBarry Smith       ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
4147fa7f1dd8SStefano Zampini       ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
41486e683305SStefano Zampini       coarse_mat_reuse = MAT_REUSE_MATRIX;
4149fa7f1dd8SStefano Zampini     } else {
41506e683305SStefano Zampini       coarse_mat_reuse = MAT_INITIAL_MATRIX;
4151fa7f1dd8SStefano Zampini     }
4152c8587f34SStefano Zampini     if (isbddc || isnn) {
415322bc73bbSStefano Zampini       if (pcbddc->coarsening_ratio > 1) {
415470cf5478SStefano Zampini         if (!pcbddc->coarse_subassembling) { /* subassembling info is not present */
415528143c3dSStefano Zampini           ierr = MatISGetSubassemblingPattern(coarse_mat_is,active_procs/pcbddc->coarsening_ratio,PETSC_TRUE,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
415622b6e8a2SStefano Zampini           if (pcbddc->dbg_flag) {
41576e683305SStefano Zampini             ierr = PetscViewerASCIIPrintf(dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
41586e683305SStefano Zampini             ierr = PetscViewerASCIIPrintf(dbg_viewer,"Subassembling pattern\n");CHKERRQ(ierr);
41596e683305SStefano Zampini             ierr = ISView(pcbddc->coarse_subassembling,dbg_viewer);CHKERRQ(ierr);
41606e683305SStefano Zampini             ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
416122b6e8a2SStefano Zampini           }
416270cf5478SStefano Zampini         }
41636e683305SStefano Zampini         ierr = MatISSubassemble(coarse_mat_is,pcbddc->coarse_subassembling,0,PETSC_FALSE,coarse_mat_reuse,&coarse_mat,0,NULL);CHKERRQ(ierr);
416470cf5478SStefano Zampini       } else {
416522bc73bbSStefano Zampini         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
416622bc73bbSStefano Zampini         coarse_mat = coarse_mat_is;
416722bc73bbSStefano Zampini       }
416822bc73bbSStefano Zampini     } else {
41692e1e5fa4SStefano Zampini       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
4170c8587f34SStefano Zampini     }
4171c8587f34SStefano Zampini     ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
4172c8587f34SStefano Zampini 
4173c8587f34SStefano Zampini     /* propagate symmetry info to coarse matrix */
4174b9d89cd5SStefano Zampini     ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pcbddc->issym);CHKERRQ(ierr);
41755a16e3a0SStefano Zampini     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
4176c8587f34SStefano Zampini 
41776e683305SStefano Zampini     /* set operators */
41785f76c7aeSStefano Zampini     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
41796e683305SStefano Zampini     if (pcbddc->dbg_flag) {
41806e683305SStefano Zampini       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
41816e683305SStefano Zampini     }
41826e683305SStefano Zampini   } else { /* processes non partecipating to coarse solver (if any) */
41836e683305SStefano Zampini     coarse_mat = 0;
41846e683305SStefano Zampini   }
41856e683305SStefano Zampini   ierr = PetscFree(isarray);CHKERRQ(ierr);
4186b9b85e73SStefano Zampini #if 0
4187b9b85e73SStefano Zampini   {
4188b9b85e73SStefano Zampini     PetscViewer viewer;
4189b9b85e73SStefano Zampini     char filename[256];
4190b9b85e73SStefano Zampini     sprintf(filename,"coarse_mat.m");
4191b9b85e73SStefano Zampini     ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,filename,&viewer);CHKERRQ(ierr);
4192b9b85e73SStefano Zampini     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4193b9b85e73SStefano Zampini     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
4194b9b85e73SStefano Zampini     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4195b9b85e73SStefano Zampini   }
4196b9b85e73SStefano Zampini #endif
4197c8587f34SStefano Zampini 
4198c8587f34SStefano Zampini   /* Compute coarse null space (special handling by BDDC only) */
4199c8587f34SStefano Zampini   if (pcbddc->NullSpace) {
4200c8587f34SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,coarse_mat,&CoarseNullSpace);CHKERRQ(ierr);
420198a51de6SStefano Zampini   }
420298a51de6SStefano Zampini 
420398a51de6SStefano Zampini   if (pcbddc->coarse_ksp) {
420498a51de6SStefano Zampini     Vec crhs,csol;
420598a51de6SStefano Zampini     PetscBool ispreonly;
420698a51de6SStefano Zampini     if (CoarseNullSpace) {
4207c8587f34SStefano Zampini       if (isbddc) {
4208c8587f34SStefano Zampini         ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
4209c8587f34SStefano Zampini       } else {
4210c8587f34SStefano Zampini         ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
4211c8587f34SStefano Zampini       }
4212c8587f34SStefano Zampini     }
4213f9eb5b7dSStefano Zampini     /* setup coarse ksp */
4214f9eb5b7dSStefano Zampini     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
4215f347579bSStefano Zampini     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
4216f347579bSStefano Zampini     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
42176e683305SStefano Zampini     /* hack */
4218f347579bSStefano Zampini     if (!csol) {
42192a7a6963SBarry Smith       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
4220f9eb5b7dSStefano Zampini     }
4221f347579bSStefano Zampini     if (!crhs) {
42222a7a6963SBarry Smith       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
4223f347579bSStefano Zampini     }
4224cbcc2c2aSStefano Zampini     /* Check coarse problem if in debug mode or if solving with an iterative method */
4225cbcc2c2aSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
42266e683305SStefano Zampini     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
4227c8587f34SStefano Zampini       KSP       check_ksp;
42282b510759SStefano Zampini       KSPType   check_ksp_type;
4229c8587f34SStefano Zampini       PC        check_pc;
42306e683305SStefano Zampini       Vec       check_vec,coarse_vec;
42316a1308c2SStefano Zampini       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
42322b510759SStefano Zampini       PetscInt  its;
42336e683305SStefano Zampini       PetscBool compute_eigs;
42346e683305SStefano Zampini       PetscReal *eigs_r,*eigs_c;
42356e683305SStefano Zampini       PetscInt  neigs;
42368e185a42SStefano Zampini       const char *prefix;
4237c8587f34SStefano Zampini 
42382b510759SStefano Zampini       /* Create ksp object suitable for estimation of extreme eigenvalues */
42396e683305SStefano Zampini       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
424023ee1639SBarry Smith       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
4241f4ddd8eeSStefano Zampini       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
42422b510759SStefano Zampini       if (ispreonly) {
42432b510759SStefano Zampini         check_ksp_type = KSPPREONLY;
42446e683305SStefano Zampini         compute_eigs = PETSC_FALSE;
42452b510759SStefano Zampini       } else {
4246cbcc2c2aSStefano Zampini         check_ksp_type = KSPGMRES;
42476e683305SStefano Zampini         compute_eigs = PETSC_TRUE;
4248c8587f34SStefano Zampini       }
4249c8587f34SStefano Zampini       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
42506e683305SStefano Zampini       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
42516e683305SStefano Zampini       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
42526e683305SStefano Zampini       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
4253a7dc3881SStefano Zampini       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
4254a7dc3881SStefano Zampini       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
4255a7dc3881SStefano Zampini       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
4256a7dc3881SStefano Zampini       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
4257c8587f34SStefano Zampini       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
4258c8587f34SStefano Zampini       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
4259c8587f34SStefano Zampini       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
4260c8587f34SStefano Zampini       /* create random vec */
42616e683305SStefano Zampini       ierr = KSPGetSolution(pcbddc->coarse_ksp,&coarse_vec);CHKERRQ(ierr);
42626e683305SStefano Zampini       ierr = VecDuplicate(coarse_vec,&check_vec);CHKERRQ(ierr);
4263c8587f34SStefano Zampini       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
4264c8587f34SStefano Zampini       if (CoarseNullSpace) {
4265c8587f34SStefano Zampini         ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
4266c8587f34SStefano Zampini       }
42676e683305SStefano Zampini       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
4268c8587f34SStefano Zampini       /* solve coarse problem */
42696e683305SStefano Zampini       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
4270c8587f34SStefano Zampini       if (CoarseNullSpace) {
42716e683305SStefano Zampini         ierr = MatNullSpaceRemove(CoarseNullSpace,coarse_vec);CHKERRQ(ierr);
4272c8587f34SStefano Zampini       }
4273cbcc2c2aSStefano Zampini       /* set eigenvalue estimation if preonly has not been requested */
42746e683305SStefano Zampini       if (compute_eigs) {
4275854ce69bSBarry Smith         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
4276854ce69bSBarry Smith         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
42776e683305SStefano Zampini         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
42786e683305SStefano Zampini         lambda_max = eigs_r[neigs-1];
42796e683305SStefano Zampini         lambda_min = eigs_r[0];
42806e683305SStefano Zampini         if (pcbddc->use_coarse_estimates) {
42816e683305SStefano Zampini           if (lambda_max>lambda_min) {
4282cbcc2c2aSStefano Zampini             ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max,lambda_min);CHKERRQ(ierr);
4283cbcc2c2aSStefano Zampini             ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
4284cbcc2c2aSStefano Zampini           }
4285c8587f34SStefano Zampini         }
4286c8587f34SStefano Zampini       }
4287cbcc2c2aSStefano Zampini 
4288c8587f34SStefano Zampini       /* check coarse problem residual error */
42896e683305SStefano Zampini       if (pcbddc->dbg_flag) {
42906e683305SStefano Zampini         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
42916e683305SStefano Zampini         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
42926e683305SStefano Zampini         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
4293c8587f34SStefano Zampini         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
42946e683305SStefano Zampini         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
42956e683305SStefano Zampini         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
4296c8587f34SStefano Zampini         ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
4297779c1cceSStefano Zampini         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
42986e683305SStefano Zampini         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
42996e683305SStefano Zampini         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
43006e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
43016e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
43026e683305SStefano Zampini         if (compute_eigs) {
43036e683305SStefano Zampini           PetscReal lambda_max_s,lambda_min_s;
4304deec49d1SStefano Zampini           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
4305c8587f34SStefano Zampini           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
43066e683305SStefano Zampini           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
43076e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem eigenvalues (estimated with %d iterations of %s): %1.6e %1.6e (%1.6e %1.6e)\n",its,check_ksp_type,lambda_min,lambda_max,lambda_min_s,lambda_max_s);CHKERRQ(ierr);
43086e683305SStefano Zampini           for (i=0;i<neigs;i++) {
43096e683305SStefano Zampini             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
4310c8587f34SStefano Zampini           }
43116e683305SStefano Zampini         }
43126e683305SStefano Zampini         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
43136e683305SStefano Zampini         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
43146e683305SStefano Zampini       }
4315c8587f34SStefano Zampini       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
43166e683305SStefano Zampini       if (compute_eigs) {
43176e683305SStefano Zampini         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
43186e683305SStefano Zampini         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
4319c8587f34SStefano Zampini       }
43206e683305SStefano Zampini     }
43216e683305SStefano Zampini   }
4322cbcc2c2aSStefano Zampini   /* print additional info */
4323cbcc2c2aSStefano Zampini   if (pcbddc->dbg_flag) {
43246e683305SStefano Zampini     /* waits until all processes reaches this point */
43256e683305SStefano Zampini     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
4326cbcc2c2aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
4327cbcc2c2aSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4328cbcc2c2aSStefano Zampini   }
4329cbcc2c2aSStefano Zampini 
43302b510759SStefano Zampini   /* free memory */
4331c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
4332fdc635d7SStefano Zampini   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
4333c8587f34SStefano Zampini   PetscFunctionReturn(0);
4334c8587f34SStefano Zampini }
4335674ae819SStefano Zampini 
4336f34684f1SStefano Zampini #undef __FUNCT__
4337f34684f1SStefano Zampini #define __FUNCT__ "PCBDDCComputePrimalNumbering"
4338f34684f1SStefano Zampini PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
4339f34684f1SStefano Zampini {
4340f34684f1SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4341f34684f1SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
4342f34684f1SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
434373be2a3aSStefano Zampini   PetscInt       i,coarse_size=0;
434473be2a3aSStefano Zampini   PetscInt       *local_primal_indices=NULL;
4345f34684f1SStefano Zampini   PetscErrorCode ierr;
4346f34684f1SStefano Zampini 
4347f34684f1SStefano Zampini   PetscFunctionBegin;
4348f34684f1SStefano Zampini   /* Compute global number of coarse dofs */
434989c96988SStefano Zampini   if (!pcbddc->primal_indices_local_idxs && pcbddc->local_primal_size) {
435089c96988SStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Local primal indices have not been created");
4351727cdba6SStefano Zampini   }
4352727cdba6SStefano Zampini   ierr = PCBDDCSubsetNumbering(PetscObjectComm((PetscObject)(pc->pmat)),matis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,NULL,&coarse_size,&local_primal_indices);CHKERRQ(ierr);
4353f34684f1SStefano Zampini 
4354f34684f1SStefano Zampini   /* check numbering */
4355f34684f1SStefano Zampini   if (pcbddc->dbg_flag) {
4356f34684f1SStefano Zampini     PetscScalar coarsesum,*array;
4357b9b85e73SStefano Zampini     PetscBool set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
4358f34684f1SStefano Zampini 
4359f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4360f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4361f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
43620fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
4363f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
4364f34684f1SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
4365727cdba6SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
4366f34684f1SStefano Zampini     }
4367f34684f1SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
4368f34684f1SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
4369f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
4370f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4371f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4372f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4373f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4374f34684f1SStefano Zampini     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4375f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
4376f34684f1SStefano Zampini       if (array[i] == 1.0) {
4377b9b85e73SStefano Zampini         set_error = PETSC_TRUE;
4378f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d owned by a single process!\n",PetscGlobalRank,i);CHKERRQ(ierr);
4379f34684f1SStefano Zampini       }
4380f34684f1SStefano Zampini     }
4381b9b85e73SStefano Zampini     ierr = MPI_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4382f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4383f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
4384f34684f1SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
4385f34684f1SStefano Zampini     }
4386f34684f1SStefano Zampini     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4387f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
4388f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4389f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4390f34684f1SStefano Zampini     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
4391f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
4392b9b85e73SStefano Zampini     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
4393ca8b9ea9SStefano Zampini       PetscInt *gidxs;
4394ca8b9ea9SStefano Zampini 
4395ca8b9ea9SStefano Zampini       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
4396ca8b9ea9SStefano Zampini       ierr = ISLocalToGlobalMappingApply(matis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
4397f34684f1SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
4398f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4399f34684f1SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
4400f34684f1SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
44014bc2dc4bSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_primal_indices[%d]=%d (%d,%d)\n",i,local_primal_indices[i],pcbddc->primal_indices_local_idxs[i],gidxs[i]);CHKERRQ(ierr);
4402f34684f1SStefano Zampini       }
4403f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4404ca8b9ea9SStefano Zampini       ierr = PetscFree(gidxs);CHKERRQ(ierr);
4405f34684f1SStefano Zampini     }
4406f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4407302440fdSBarry Smith     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
4408f34684f1SStefano Zampini   }
44098bec7fa6SStefano Zampini   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
4410f34684f1SStefano Zampini   /* get back data */
4411f34684f1SStefano Zampini   *coarse_size_n = coarse_size;
4412f34684f1SStefano Zampini   *local_primal_indices_n = local_primal_indices;
4413674ae819SStefano Zampini   PetscFunctionReturn(0);
4414674ae819SStefano Zampini }
4415674ae819SStefano Zampini 
4416e456f2a8SStefano Zampini #undef __FUNCT__
4417e456f2a8SStefano Zampini #define __FUNCT__ "PCBDDCGlobalToLocal"
4418a7dc3881SStefano Zampini PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
4419e456f2a8SStefano Zampini {
4420e456f2a8SStefano Zampini   IS             localis_t;
4421a7dc3881SStefano Zampini   PetscInt       i,lsize,*idxs,n;
4422e456f2a8SStefano Zampini   PetscScalar    *vals;
4423e456f2a8SStefano Zampini   PetscErrorCode ierr;
4424e456f2a8SStefano Zampini 
4425e456f2a8SStefano Zampini   PetscFunctionBegin;
4426a7dc3881SStefano Zampini   /* get indices in local ordering exploiting local to global map */
4427e456f2a8SStefano Zampini   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
4428854ce69bSBarry Smith   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
4429e456f2a8SStefano Zampini   for (i=0;i<lsize;i++) vals[i] = 1.0;
4430e456f2a8SStefano Zampini   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
4431a7dc3881SStefano Zampini   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
4432a7dc3881SStefano Zampini   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
44331035eff8SStefano Zampini   if (idxs) { /* multilevel guard */
4434a7dc3881SStefano Zampini     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
44351035eff8SStefano Zampini   }
4436a7dc3881SStefano Zampini   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
4437e456f2a8SStefano Zampini   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
4438e456f2a8SStefano Zampini   ierr = PetscFree(vals);CHKERRQ(ierr);
4439a7dc3881SStefano Zampini   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
4440a7dc3881SStefano Zampini   /* now compute set in local ordering */
4441a7dc3881SStefano Zampini   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4442a7dc3881SStefano Zampini   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4443a7dc3881SStefano Zampini   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
4444a7dc3881SStefano Zampini   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
4445a7dc3881SStefano Zampini   for (i=0,lsize=0;i<n;i++) {
4446ff92baa0SMatthew G. Knepley     if (PetscRealPart(vals[i]) > 0.5) {
4447e456f2a8SStefano Zampini       lsize++;
4448e456f2a8SStefano Zampini     }
4449e456f2a8SStefano Zampini   }
4450854ce69bSBarry Smith   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
4451a7dc3881SStefano Zampini   for (i=0,lsize=0;i<n;i++) {
4452ff92baa0SMatthew G. Knepley     if (PetscRealPart(vals[i]) > 0.5) {
4453e456f2a8SStefano Zampini       idxs[lsize++] = i;
4454e456f2a8SStefano Zampini     }
4455e456f2a8SStefano Zampini   }
4456a7dc3881SStefano Zampini   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
4457a7dc3881SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
4458e456f2a8SStefano Zampini   *localis = localis_t;
4459e456f2a8SStefano Zampini   PetscFunctionReturn(0);
4460e456f2a8SStefano Zampini }
4461906d46d4SStefano Zampini 
4462906d46d4SStefano Zampini /* the next two functions will be called in KSPMatMult if a change of basis has been requested */
4463906d46d4SStefano Zampini #undef __FUNCT__
4464906d46d4SStefano Zampini #define __FUNCT__ "PCBDDCMatMult_Private"
4465906d46d4SStefano Zampini static PetscErrorCode PCBDDCMatMult_Private(Mat A, Vec x, Vec y)
4466906d46d4SStefano Zampini {
4467906d46d4SStefano Zampini   PCBDDCChange_ctx change_ctx;
4468906d46d4SStefano Zampini   PetscErrorCode   ierr;
4469906d46d4SStefano Zampini 
4470906d46d4SStefano Zampini   PetscFunctionBegin;
4471906d46d4SStefano Zampini   ierr = MatShellGetContext(A,&change_ctx);CHKERRQ(ierr);
4472906d46d4SStefano Zampini   ierr = MatMult(change_ctx->global_change,x,change_ctx->work[0]);CHKERRQ(ierr);
4473906d46d4SStefano Zampini   ierr = MatMult(change_ctx->original_mat,change_ctx->work[0],change_ctx->work[1]);CHKERRQ(ierr);
4474906d46d4SStefano Zampini   ierr = MatMultTranspose(change_ctx->global_change,change_ctx->work[1],y);CHKERRQ(ierr);
4475906d46d4SStefano Zampini   PetscFunctionReturn(0);
4476906d46d4SStefano Zampini }
4477906d46d4SStefano Zampini 
4478906d46d4SStefano Zampini #undef __FUNCT__
4479906d46d4SStefano Zampini #define __FUNCT__ "PCBDDCMatMultTranspose_Private"
4480906d46d4SStefano Zampini static PetscErrorCode PCBDDCMatMultTranspose_Private(Mat A, Vec x, Vec y)
4481906d46d4SStefano Zampini {
4482906d46d4SStefano Zampini   PCBDDCChange_ctx change_ctx;
4483906d46d4SStefano Zampini   PetscErrorCode   ierr;
4484906d46d4SStefano Zampini 
4485906d46d4SStefano Zampini   PetscFunctionBegin;
4486906d46d4SStefano Zampini   ierr = MatShellGetContext(A,&change_ctx);CHKERRQ(ierr);
4487906d46d4SStefano Zampini   ierr = MatMult(change_ctx->global_change,x,change_ctx->work[0]);CHKERRQ(ierr);
4488906d46d4SStefano Zampini   ierr = MatMultTranspose(change_ctx->original_mat,change_ctx->work[0],change_ctx->work[1]);CHKERRQ(ierr);
4489906d46d4SStefano Zampini   ierr = MatMultTranspose(change_ctx->global_change,change_ctx->work[1],y);CHKERRQ(ierr);
4490906d46d4SStefano Zampini   PetscFunctionReturn(0);
4491906d46d4SStefano Zampini }
4492b96c3477SStefano Zampini 
4493b96c3477SStefano Zampini #undef __FUNCT__
4494b96c3477SStefano Zampini #define __FUNCT__ "PCBDDCSetUpSubSchurs"
449508122e43SStefano Zampini PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
4496b96c3477SStefano Zampini {
4497a64f4aa4SStefano Zampini   PC_IS               *pcis=(PC_IS*)pc->data;
4498b96c3477SStefano Zampini   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
4499b96c3477SStefano Zampini   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
4500a64f4aa4SStefano Zampini   Mat                 S_j;
4501b96c3477SStefano Zampini   PetscInt            *used_xadj,*used_adjncy;
4502b96c3477SStefano Zampini   PetscBool           free_used_adj;
4503b96c3477SStefano Zampini   PetscErrorCode      ierr;
4504b96c3477SStefano Zampini 
4505b96c3477SStefano Zampini   PetscFunctionBegin;
4506b96c3477SStefano Zampini   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
4507b96c3477SStefano Zampini   free_used_adj = PETSC_FALSE;
450808122e43SStefano Zampini   if (pcbddc->sub_schurs_layers == -1) {
4509b96c3477SStefano Zampini     used_xadj = NULL;
4510b96c3477SStefano Zampini     used_adjncy = NULL;
4511b96c3477SStefano Zampini   } else {
451208122e43SStefano Zampini     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
451308122e43SStefano Zampini       used_xadj = pcbddc->mat_graph->xadj;
451408122e43SStefano Zampini       used_adjncy = pcbddc->mat_graph->adjncy;
451508122e43SStefano Zampini     } else if (pcbddc->computed_rowadj) {
4516b96c3477SStefano Zampini       used_xadj = pcbddc->mat_graph->xadj;
4517b96c3477SStefano Zampini       used_adjncy = pcbddc->mat_graph->adjncy;
4518b96c3477SStefano Zampini     } else {
45192fffb893SStefano Zampini       PetscBool      flg_row=PETSC_FALSE;
4520b96c3477SStefano Zampini       const PetscInt *xadj,*adjncy;
4521b96c3477SStefano Zampini       PetscInt       nvtxs;
4522b96c3477SStefano Zampini 
45232fffb893SStefano Zampini       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
45242fffb893SStefano Zampini       if (flg_row) {
4525b96c3477SStefano Zampini         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
4526b96c3477SStefano Zampini         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
4527b96c3477SStefano Zampini         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
4528b96c3477SStefano Zampini         free_used_adj = PETSC_TRUE;
45292fffb893SStefano Zampini       } else {
45302fffb893SStefano Zampini         pcbddc->sub_schurs_layers = -1;
45312fffb893SStefano Zampini         used_xadj = NULL;
45322fffb893SStefano Zampini         used_adjncy = NULL;
45332fffb893SStefano Zampini       }
45342fffb893SStefano Zampini       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4535b96c3477SStefano Zampini     }
4536b96c3477SStefano Zampini   }
4537d5574798SStefano Zampini 
4538d5574798SStefano Zampini   /* setup sub_schurs data */
4539a64f4aa4SStefano Zampini   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
4540a64f4aa4SStefano Zampini   if (!sub_schurs->use_mumps) {
4541a64f4aa4SStefano Zampini     /* pcbddc->ksp_D up to date only if not using MUMPS */
4542a64f4aa4SStefano Zampini     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
4543a64f4aa4SStefano Zampini     ierr = PCBDDCSubSchursSetUp(sub_schurs,NULL,S_j,used_xadj,used_adjncy,pcbddc->sub_schurs_layers,pcbddc->faster_deluxe,pcbddc->adaptive_selection,pcbddc->use_edges,pcbddc->use_faces);CHKERRQ(ierr);
4544a64f4aa4SStefano Zampini   } else {
4545a64f4aa4SStefano Zampini     ierr = PCBDDCSubSchursSetUp(sub_schurs,pcbddc->local_mat,S_j,used_xadj,used_adjncy,pcbddc->sub_schurs_layers,pcbddc->faster_deluxe,pcbddc->adaptive_selection,pcbddc->use_edges,pcbddc->use_faces);CHKERRQ(ierr);
4546a64f4aa4SStefano Zampini   }
4547a64f4aa4SStefano Zampini   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
4548b96c3477SStefano Zampini 
4549b96c3477SStefano Zampini   /* free adjacency */
4550b96c3477SStefano Zampini   if (free_used_adj) {
4551b96c3477SStefano Zampini     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
4552b96c3477SStefano Zampini   }
4553b96c3477SStefano Zampini   PetscFunctionReturn(0);
4554b96c3477SStefano Zampini }
4555b96c3477SStefano Zampini 
4556b96c3477SStefano Zampini #undef __FUNCT__
4557b96c3477SStefano Zampini #define __FUNCT__ "PCBDDCInitSubSchurs"
455808122e43SStefano Zampini PetscErrorCode PCBDDCInitSubSchurs(PC pc)
4559b96c3477SStefano Zampini {
4560b96c3477SStefano Zampini   PC_IS               *pcis=(PC_IS*)pc->data;
4561b96c3477SStefano Zampini   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
4562b96c3477SStefano Zampini   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
4563b96c3477SStefano Zampini   PCBDDCGraph         graph;
4564b96c3477SStefano Zampini   PetscErrorCode      ierr;
4565b96c3477SStefano Zampini 
4566b96c3477SStefano Zampini   PetscFunctionBegin;
4567b96c3477SStefano Zampini   /* attach interface graph for determining subsets */
456808122e43SStefano Zampini   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
4569b96c3477SStefano Zampini     IS verticesIS;
4570b96c3477SStefano Zampini 
4571b96c3477SStefano Zampini     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
4572b96c3477SStefano Zampini     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
45737fb0e2dbSStefano Zampini     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global);CHKERRQ(ierr);
4574b96c3477SStefano Zampini     ierr = PCBDDCGraphSetUp(graph,0,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticesIS);CHKERRQ(ierr);
4575b96c3477SStefano Zampini     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
4576b96c3477SStefano Zampini     ierr = ISDestroy(&verticesIS);CHKERRQ(ierr);
4577b96c3477SStefano Zampini /*
4578b96c3477SStefano Zampini     if (pcbddc->dbg_flag) {
4579b96c3477SStefano Zampini       ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
4580b96c3477SStefano Zampini     }
4581b96c3477SStefano Zampini */
4582b96c3477SStefano Zampini   } else {
4583b96c3477SStefano Zampini     graph = pcbddc->mat_graph;
4584b96c3477SStefano Zampini   }
4585b96c3477SStefano Zampini 
4586b96c3477SStefano Zampini   /* sub_schurs init */
4587a64f4aa4SStefano Zampini   ierr = PCBDDCSubSchursInit(sub_schurs,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap);CHKERRQ(ierr);
4588a64f4aa4SStefano Zampini 
4589b96c3477SStefano Zampini   /* free graph struct */
459008122e43SStefano Zampini   if (pcbddc->sub_schurs_rebuild) {
4591b96c3477SStefano Zampini     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
4592b96c3477SStefano Zampini   }
4593b96c3477SStefano Zampini   PetscFunctionReturn(0);
4594b96c3477SStefano Zampini }
4595