xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision bc8044897e7dd696d944c9da6932220d985c1e43)
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;
1763*bc804489SStefano Zampini   PetscInt          *aux_primal_numbering;
1764984c4197SStefano Zampini   /* iterators */
1765984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
1766984c4197SStefano Zampini   /* BLAS integers */
1767e310c8b4SStefano Zampini   PetscBLASInt      lwork,lierr;
1768e310c8b4SStefano Zampini   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
1769c4303822SStefano Zampini   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
1770727cdba6SStefano Zampini   /* reuse */
1771727cdba6SStefano Zampini   PetscInt          olocal_primal_size;
1772727cdba6SStefano Zampini   PetscInt          *oprimal_indices_local_idxs;
1773984c4197SStefano Zampini   /* change of basis */
1774a717540cSStefano Zampini   PetscBool         boolforchange,qr_needed;
1775a717540cSStefano Zampini   PetscBT           touched,change_basis,qr_needed_idx;
1776984c4197SStefano Zampini   /* auxiliary stuff */
177739e2fb2aSStefano Zampini   PetscInt          *nnz,*is_indices,*aux_primal_numbering_B;
17788a0068c3SStefano Zampini   PetscInt          ncc;
1779984c4197SStefano Zampini   /* some quantities */
178045a1bb75SStefano Zampini   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
1781a58a30b4SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
1782984c4197SStefano Zampini 
1783674ae819SStefano Zampini   PetscFunctionBegin;
17848e61c736SStefano Zampini   /* Destroy Mat objects computed previously */
17858e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
17868e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1787088faed8SStefano Zampini   /* save info on constraints from previous setup (if any) */
1788088faed8SStefano Zampini   olocal_primal_size = pcbddc->local_primal_size;
1789088faed8SStefano Zampini   ierr = PetscMalloc1(olocal_primal_size,&oprimal_indices_local_idxs);CHKERRQ(ierr);
1790088faed8SStefano Zampini   ierr = PetscMemcpy(oprimal_indices_local_idxs,pcbddc->primal_indices_local_idxs,olocal_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
1791088faed8SStefano Zampini   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
1792cf5a6209SStefano Zampini 
1793cf5a6209SStefano Zampini   /* print some info */
1794cf5a6209SStefano Zampini   if (pcbddc->dbg_flag) {
1795cf5a6209SStefano Zampini     IS       vertices;
1796cf5a6209SStefano Zampini     PetscInt nv,nedges,nfaces;
1797cf5a6209SStefano Zampini     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
1798cf5a6209SStefano Zampini     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
1799cf5a6209SStefano Zampini     ierr = ISDestroy(&vertices);CHKERRQ(ierr);
1800cf5a6209SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1801cf5a6209SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1802cf5a6209SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
1803fd14bc51SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
1804fd14bc51SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
1805cf5a6209SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1806cf5a6209SStefano Zampini   }
1807cf5a6209SStefano Zampini 
1808cf5a6209SStefano Zampini   if (!pcbddc->adaptive_selection) {
1809cf5a6209SStefano Zampini     IS           ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
1810cf5a6209SStefano Zampini     MatNullSpace nearnullsp;
1811cf5a6209SStefano Zampini     const Vec    *nearnullvecs;
1812cf5a6209SStefano Zampini     Vec          *localnearnullsp;
1813cf5a6209SStefano Zampini     PetscScalar  *array;
1814cf5a6209SStefano Zampini     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
1815cf5a6209SStefano Zampini     PetscBool    nnsp_has_cnst;
1816cf5a6209SStefano Zampini     /* LAPACK working arrays for SVD or POD */
1817cf5a6209SStefano Zampini     PetscBool    skip_lapack;
1818cf5a6209SStefano Zampini     PetscScalar  *work;
1819cf5a6209SStefano Zampini     PetscReal    *singular_vals;
1820cf5a6209SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1821cf5a6209SStefano Zampini     PetscReal    *rwork;
1822cf5a6209SStefano Zampini #endif
1823cf5a6209SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1824cf5a6209SStefano Zampini     PetscScalar  *temp_basis,*correlation_mat;
1825cf5a6209SStefano Zampini #else
1826964fefecSStefano Zampini     PetscBLASInt dummy_int=1;
1827964fefecSStefano Zampini     PetscScalar  dummy_scalar=1.;
1828cf5a6209SStefano Zampini #endif
1829cf5a6209SStefano Zampini 
1830674ae819SStefano Zampini     /* Get index sets for faces, edges and vertices from graph */
1831d06fc5fdSStefano Zampini     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
1832d06fc5fdSStefano Zampini     /* free unneeded index sets */
1833d06fc5fdSStefano Zampini     if (!pcbddc->use_vertices) {
1834d06fc5fdSStefano Zampini       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
1835674ae819SStefano Zampini     }
1836d06fc5fdSStefano Zampini     if (!pcbddc->use_edges) {
1837d06fc5fdSStefano Zampini       for (i=0;i<n_ISForEdges;i++) {
1838d06fc5fdSStefano Zampini         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1839d06fc5fdSStefano Zampini       }
1840d06fc5fdSStefano Zampini       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1841d06fc5fdSStefano Zampini       n_ISForEdges = 0;
1842d06fc5fdSStefano Zampini     }
1843d06fc5fdSStefano Zampini     if (!pcbddc->use_faces) {
1844d06fc5fdSStefano Zampini       for (i=0;i<n_ISForFaces;i++) {
1845d06fc5fdSStefano Zampini         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1846d06fc5fdSStefano Zampini       }
1847d06fc5fdSStefano Zampini       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1848d06fc5fdSStefano Zampini       n_ISForFaces = 0;
1849d06fc5fdSStefano Zampini     }
1850d06fc5fdSStefano Zampini     /* HACKS (the following two blocks of code) */
1851b9b85e73SStefano Zampini     if (!ISForVertices && pcbddc->NullSpace && !pcbddc->user_ChangeOfBasisMatrix) {
1852b8ffe317SStefano Zampini       pcbddc->use_change_of_basis = PETSC_TRUE;
1853d06fc5fdSStefano Zampini       if (!ISForEdges) {
1854d06fc5fdSStefano Zampini         pcbddc->use_change_on_faces = PETSC_TRUE;
1855d06fc5fdSStefano Zampini       }
1856b8ffe317SStefano Zampini     }
185798a51de6SStefano Zampini     if (pcbddc->NullSpace) {
185898a51de6SStefano Zampini       /* use_change_of_basis should be consistent among processors */
1859d06fc5fdSStefano Zampini       PetscBool tbool[2],gbool[2];
1860d06fc5fdSStefano Zampini       tbool[0] = pcbddc->use_change_of_basis;
1861d06fc5fdSStefano Zampini       tbool[1] = pcbddc->use_change_on_faces;
1862d06fc5fdSStefano Zampini       ierr = MPI_Allreduce(tbool,gbool,2,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1863d06fc5fdSStefano Zampini       pcbddc->use_change_of_basis = gbool[0];
1864d06fc5fdSStefano Zampini       pcbddc->use_change_on_faces = gbool[1];
186598a51de6SStefano Zampini     }
186608122e43SStefano Zampini 
1867674ae819SStefano Zampini     /* check if near null space is attached to global mat */
1868674ae819SStefano Zampini     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
1869674ae819SStefano Zampini     if (nearnullsp) {
1870674ae819SStefano Zampini       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
1871f4ddd8eeSStefano Zampini       /* remove any stored info */
1872f4ddd8eeSStefano Zampini       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
1873f4ddd8eeSStefano Zampini       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1874f4ddd8eeSStefano Zampini       /* store information for BDDC solver reuse */
1875f4ddd8eeSStefano Zampini       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
1876f4ddd8eeSStefano Zampini       pcbddc->onearnullspace = nearnullsp;
1877473ba861SJed Brown       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1878f4ddd8eeSStefano Zampini       for (i=0;i<nnsp_size;i++) {
1879f4ddd8eeSStefano Zampini         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
1880f4ddd8eeSStefano Zampini       }
1881984c4197SStefano Zampini     } else { /* if near null space is not provided BDDC uses constants by default */
1882984c4197SStefano Zampini       nnsp_size = 0;
1883674ae819SStefano Zampini       nnsp_has_cnst = PETSC_TRUE;
1884674ae819SStefano Zampini     }
1885984c4197SStefano Zampini     /* get max number of constraints on a single cc */
1886984c4197SStefano Zampini     max_constraints = nnsp_size;
1887984c4197SStefano Zampini     if (nnsp_has_cnst) max_constraints++;
1888984c4197SStefano Zampini 
1889674ae819SStefano Zampini     /*
1890674ae819SStefano Zampini          Evaluate maximum storage size needed by the procedure
1891674ae819SStefano Zampini          - temp_indices will contain start index of each constraint stored as follows
1892911cabfeSStefano 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
1893911cabfeSStefano 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
1894911cabfeSStefano Zampini          - temp_quadrature_constraint  [temp_indices[i],...,temp_indices[i+1]-1] will contain the scalars representing the constraint itself
1895674ae819SStefano Zampini                                                                                                                                                            */
1896674ae819SStefano Zampini     total_counts = n_ISForFaces+n_ISForEdges;
1897984c4197SStefano Zampini     total_counts *= max_constraints;
1898674ae819SStefano Zampini     n_vertices = 0;
1899674ae819SStefano Zampini     if (ISForVertices) {
1900674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
1901674ae819SStefano Zampini     }
1902674ae819SStefano Zampini     total_counts += n_vertices;
1903854ce69bSBarry Smith     ierr = PetscMalloc1(total_counts+1,&temp_indices);CHKERRQ(ierr);
19044641a718SStefano Zampini     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
1905674ae819SStefano Zampini     total_counts = 0;
1906674ae819SStefano Zampini     max_size_of_constraint = 0;
1907674ae819SStefano Zampini     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1908674ae819SStefano Zampini       if (i<n_ISForEdges) {
1909674ae819SStefano Zampini         used_IS = &ISForEdges[i];
1910674ae819SStefano Zampini       } else {
1911674ae819SStefano Zampini         used_IS = &ISForFaces[i-n_ISForEdges];
1912674ae819SStefano Zampini       }
1913674ae819SStefano Zampini       ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
1914674ae819SStefano Zampini       total_counts += j;
1915674ae819SStefano Zampini       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
1916674ae819SStefano Zampini     }
1917984c4197SStefano Zampini     total_counts *= max_constraints;
1918674ae819SStefano Zampini     total_counts += n_vertices;
1919906d46d4SStefano Zampini     ierr = PetscMalloc3(total_counts,&temp_quadrature_constraint,total_counts,&temp_indices_to_constraint,total_counts,&temp_indices_to_constraint_B);CHKERRQ(ierr);
1920984c4197SStefano Zampini     /* get local part of global near null space vectors */
1921785e854fSJed Brown     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
1922984c4197SStefano Zampini     for (k=0;k<nnsp_size;k++) {
1923984c4197SStefano Zampini       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
1924984c4197SStefano Zampini       ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1925984c4197SStefano Zampini       ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1926984c4197SStefano Zampini     }
1927674ae819SStefano Zampini 
1928242a89d7SStefano Zampini     /* whether or not to skip lapack calls */
1929242a89d7SStefano Zampini     skip_lapack = PETSC_TRUE;
1930a773dcb8SStefano Zampini     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
1931242a89d7SStefano Zampini 
1932984c4197SStefano Zampini     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
1933a773dcb8SStefano Zampini     if (!skip_lapack) {
1934674ae819SStefano Zampini       PetscScalar temp_work;
1935911cabfeSStefano Zampini 
1936674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1937984c4197SStefano Zampini       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
1938785e854fSJed Brown       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
1939785e854fSJed Brown       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
1940785e854fSJed Brown       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
1941674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1942785e854fSJed Brown       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
1943674ae819SStefano Zampini #endif
1944674ae819SStefano Zampini       /* now we evaluate the optimal workspace using query with lwork=-1 */
1945c8244a33SStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
1946c8244a33SStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
1947674ae819SStefano Zampini       lwork = -1;
1948674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1949674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1950c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
1951674ae819SStefano Zampini #else
1952c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
1953674ae819SStefano Zampini #endif
1954674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1955984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
1956674ae819SStefano Zampini #else /* on missing GESVD */
1957674ae819SStefano Zampini       /* SVD */
1958674ae819SStefano Zampini       PetscInt max_n,min_n;
1959674ae819SStefano Zampini       max_n = max_size_of_constraint;
1960984c4197SStefano Zampini       min_n = max_constraints;
1961984c4197SStefano Zampini       if (max_size_of_constraint < max_constraints) {
1962674ae819SStefano Zampini         min_n = max_size_of_constraint;
1963984c4197SStefano Zampini         max_n = max_constraints;
1964674ae819SStefano Zampini       }
1965785e854fSJed Brown       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
1966674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1967785e854fSJed Brown       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
1968674ae819SStefano Zampini #endif
1969674ae819SStefano Zampini       /* now we evaluate the optimal workspace using query with lwork=-1 */
1970674ae819SStefano Zampini       lwork = -1;
1971e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
1972e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
1973b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
1974674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1975674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1976cf5a6209SStefano 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));
1977674ae819SStefano Zampini #else
1978cf5a6209SStefano 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));
1979674ae819SStefano Zampini #endif
1980674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1981984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
1982984c4197SStefano Zampini #endif /* on missing GESVD */
1983674ae819SStefano Zampini       /* Allocate optimal workspace */
1984674ae819SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
1985854ce69bSBarry Smith       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
1986674ae819SStefano Zampini     }
1987674ae819SStefano Zampini     /* Now we can loop on constraining sets */
1988674ae819SStefano Zampini     total_counts = 0;
1989674ae819SStefano Zampini     temp_indices[0] = 0;
1990674ae819SStefano Zampini     /* vertices */
1991674ae819SStefano Zampini     if (ISForVertices) {
1992674ae819SStefano Zampini       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1993674ae819SStefano Zampini       if (nnsp_has_cnst) { /* consider all vertices */
199439e2fb2aSStefano Zampini         ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
1995674ae819SStefano Zampini         for (i=0;i<n_vertices;i++) {
1996674ae819SStefano Zampini           temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1997674ae819SStefano Zampini           temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1998674ae819SStefano Zampini           total_counts++;
1999674ae819SStefano Zampini         }
2000674ae819SStefano Zampini       } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
2001984c4197SStefano Zampini         PetscBool used_vertex;
2002674ae819SStefano Zampini         for (i=0;i<n_vertices;i++) {
2003674ae819SStefano Zampini           used_vertex = PETSC_FALSE;
2004674ae819SStefano Zampini           k = 0;
2005674ae819SStefano Zampini           while (!used_vertex && k<nnsp_size) {
2006984c4197SStefano Zampini             ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
2007984c4197SStefano Zampini             if (PetscAbsScalar(array[is_indices[i]])>0.0) {
2008674ae819SStefano Zampini               temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
2009674ae819SStefano Zampini               temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
2010674ae819SStefano Zampini               temp_indices[total_counts+1]=temp_indices[total_counts]+1;
2011674ae819SStefano Zampini               total_counts++;
2012674ae819SStefano Zampini               used_vertex = PETSC_TRUE;
2013674ae819SStefano Zampini             }
2014984c4197SStefano Zampini             ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
2015674ae819SStefano Zampini             k++;
2016674ae819SStefano Zampini           }
2017674ae819SStefano Zampini         }
2018674ae819SStefano Zampini       }
2019674ae819SStefano Zampini       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2020674ae819SStefano Zampini       n_vertices = total_counts;
2021674ae819SStefano Zampini     }
2022984c4197SStefano Zampini 
2023674ae819SStefano Zampini     /* edges and faces */
2024911cabfeSStefano Zampini     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
2025911cabfeSStefano Zampini       if (ncc<n_ISForEdges) {
2026911cabfeSStefano Zampini         used_IS = &ISForEdges[ncc];
2027984c4197SStefano Zampini         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
2028674ae819SStefano Zampini       } else {
2029911cabfeSStefano Zampini         used_IS = &ISForFaces[ncc-n_ISForEdges];
2030984c4197SStefano Zampini         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
2031674ae819SStefano Zampini       }
2032674ae819SStefano Zampini       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
2033674ae819SStefano Zampini       temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
2034674ae819SStefano Zampini       ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
2035674ae819SStefano Zampini       ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2036984c4197SStefano Zampini       /* change of basis should not be performed on local periodic nodes */
2037984c4197SStefano Zampini       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
2038674ae819SStefano Zampini       if (nnsp_has_cnst) {
20395b08dc53SStefano Zampini         PetscScalar quad_value;
2040674ae819SStefano Zampini         temp_constraints++;
2041a773dcb8SStefano Zampini         if (!pcbddc->use_nnsp_true) {
2042674ae819SStefano Zampini           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
2043a773dcb8SStefano Zampini         } else {
2044a773dcb8SStefano Zampini           quad_value = 1.0;
2045a773dcb8SStefano Zampini         }
204639e2fb2aSStefano Zampini         ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
2047674ae819SStefano Zampini         for (j=0;j<size_of_constraint;j++) {
2048674ae819SStefano Zampini           temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
2049674ae819SStefano Zampini         }
2050674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
2051674ae819SStefano Zampini         total_counts++;
2052674ae819SStefano Zampini       }
2053674ae819SStefano Zampini       for (k=0;k<nnsp_size;k++) {
2054984c4197SStefano Zampini         PetscReal real_value;
2055984c4197SStefano Zampini         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
205639e2fb2aSStefano Zampini         ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
2057674ae819SStefano Zampini         for (j=0;j<size_of_constraint;j++) {
2058984c4197SStefano Zampini           temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
2059674ae819SStefano Zampini         }
2060984c4197SStefano Zampini         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
2061984c4197SStefano Zampini         /* check if array is null on the connected component */
2062e310c8b4SStefano Zampini         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2063e310c8b4SStefano Zampini         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one));
20645b08dc53SStefano Zampini         if (real_value > 0.0) { /* keep indices and values */
2065674ae819SStefano Zampini           temp_constraints++;
2066674ae819SStefano Zampini           temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
2067674ae819SStefano Zampini           total_counts++;
2068674ae819SStefano Zampini         }
2069674ae819SStefano Zampini       }
2070674ae819SStefano Zampini       ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
207145a1bb75SStefano Zampini       valid_constraints = temp_constraints;
2072eb97c9d2SStefano Zampini       if (!pcbddc->use_nnsp_true && temp_constraints) {
2073a773dcb8SStefano Zampini         if (temp_constraints == 1) { /* just normalize the constraint */
2074a773dcb8SStefano Zampini           PetscScalar norm;
2075a773dcb8SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2076a773dcb8SStefano 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));
2077a773dcb8SStefano Zampini           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
2078a773dcb8SStefano Zampini           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,temp_quadrature_constraint+temp_indices[temp_start_ptr],&Blas_one));
2079a773dcb8SStefano Zampini         } else { /* perform SVD */
2080984c4197SStefano Zampini           PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
2081674ae819SStefano Zampini 
2082674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
2083984c4197SStefano Zampini           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
2084984c4197SStefano Zampini              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
2085984c4197SStefano Zampini              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
2086984c4197SStefano Zampini                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
2087984c4197SStefano Zampini                 from that computed using LAPACKgesvd
2088984c4197SStefano Zampini              -> This is due to a different computation of eigenvectors in LAPACKheev
2089984c4197SStefano Zampini              -> The quality of the POD-computed basis will be the same */
2090984c4197SStefano Zampini           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
2091674ae819SStefano Zampini           /* Store upper triangular part of correlation matrix */
2092e310c8b4SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2093984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2094674ae819SStefano Zampini           for (j=0;j<temp_constraints;j++) {
2095674ae819SStefano Zampini             for (k=0;k<j+1;k++) {
2096cf5a6209SStefano 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));
2097674ae819SStefano Zampini             }
2098674ae819SStefano Zampini           }
2099e310c8b4SStefano Zampini           /* compute eigenvalues and eigenvectors of correlation matrix */
2100e310c8b4SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
2101e310c8b4SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
2102674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
2103c8244a33SStefano Zampini           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
2104674ae819SStefano Zampini #else
2105c8244a33SStefano Zampini           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
2106674ae819SStefano Zampini #endif
2107674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2108984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
2109984c4197SStefano Zampini           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
2110674ae819SStefano Zampini           j = 0;
2111984c4197SStefano Zampini           while (j < temp_constraints && singular_vals[j] < tol) j++;
2112674ae819SStefano Zampini           total_counts = total_counts-j;
211345a1bb75SStefano Zampini           valid_constraints = temp_constraints-j;
2114e310c8b4SStefano Zampini           /* scale and copy POD basis into used quadrature memory */
2115c4303822SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
2116c4303822SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
2117c4303822SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
2118c4303822SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2119c4303822SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
2120c4303822SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
2121674ae819SStefano Zampini           if (j<temp_constraints) {
2122984c4197SStefano Zampini             PetscInt ii;
2123984c4197SStefano Zampini             for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
2124674ae819SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2125c4303822SStefano 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));
2126674ae819SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
2127984c4197SStefano Zampini             for (k=0;k<temp_constraints-j;k++) {
2128674ae819SStefano Zampini               for (ii=0;ii<size_of_constraint;ii++) {
2129984c4197SStefano 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];
2130674ae819SStefano Zampini               }
2131674ae819SStefano Zampini             }
2132674ae819SStefano Zampini           }
2133674ae819SStefano Zampini #else  /* on missing GESVD */
2134e310c8b4SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
2135e310c8b4SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
2136b7d8b9f8SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2137674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2138674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
2139cf5a6209SStefano 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));
2140674ae819SStefano Zampini #else
2141cf5a6209SStefano 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));
2142674ae819SStefano Zampini #endif
2143984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
2144674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2145984c4197SStefano Zampini           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
2146e310c8b4SStefano Zampini           k = temp_constraints;
2147e310c8b4SStefano Zampini           if (k > size_of_constraint) k = size_of_constraint;
2148674ae819SStefano Zampini           j = 0;
2149e310c8b4SStefano Zampini           while (j < k && singular_vals[k-j-1] < tol) j++;
215045a1bb75SStefano Zampini           valid_constraints = k-j;
2151911cabfeSStefano Zampini           total_counts = total_counts-temp_constraints+valid_constraints;
2152984c4197SStefano Zampini #endif /* on missing GESVD */
2153674ae819SStefano Zampini         }
2154a773dcb8SStefano Zampini       }
215545a1bb75SStefano Zampini       /* setting change_of_basis flag is safe now */
215645a1bb75SStefano Zampini       if (boolforchange) {
215745a1bb75SStefano Zampini         for (j=0;j<valid_constraints;j++) {
215845a1bb75SStefano Zampini           PetscBTSet(change_basis,total_counts-j-1);
215945a1bb75SStefano Zampini         }
216045a1bb75SStefano Zampini       }
2161674ae819SStefano Zampini     }
2162984c4197SStefano Zampini     /* free workspace */
21638f1c130eSStefano Zampini     if (!skip_lapack) {
2164984c4197SStefano Zampini       ierr = PetscFree(work);CHKERRQ(ierr);
2165984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
2166984c4197SStefano Zampini       ierr = PetscFree(rwork);CHKERRQ(ierr);
2167984c4197SStefano Zampini #endif
2168984c4197SStefano Zampini       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
2169984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
2170984c4197SStefano Zampini       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
2171984c4197SStefano Zampini       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
2172984c4197SStefano Zampini #endif
2173984c4197SStefano Zampini     }
2174984c4197SStefano Zampini     for (k=0;k<nnsp_size;k++) {
2175984c4197SStefano Zampini       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
2176984c4197SStefano Zampini     }
2177984c4197SStefano Zampini     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
2178cf5a6209SStefano Zampini     /* free index sets of faces, edges and vertices */
2179cf5a6209SStefano Zampini     for (i=0;i<n_ISForFaces;i++) {
2180cf5a6209SStefano Zampini       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
2181cf5a6209SStefano Zampini     }
2182cf5a6209SStefano Zampini     if (n_ISForFaces) {
2183cf5a6209SStefano Zampini       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
2184cf5a6209SStefano Zampini     }
2185cf5a6209SStefano Zampini     for (i=0;i<n_ISForEdges;i++) {
2186cf5a6209SStefano Zampini       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
2187cf5a6209SStefano Zampini     }
2188cf5a6209SStefano Zampini     if (n_ISForEdges) {
2189cf5a6209SStefano Zampini       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
2190cf5a6209SStefano Zampini     }
2191cf5a6209SStefano Zampini     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
219208122e43SStefano Zampini   } else {
219308122e43SStefano Zampini     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
219408122e43SStefano Zampini     PetscInt        cum = 0;
219508122e43SStefano Zampini 
219608122e43SStefano Zampini     total_counts = 0;
219708122e43SStefano Zampini     n_vertices = 0;
21988bec7fa6SStefano Zampini     if (sub_schurs->is_Ej_com && pcbddc->use_vertices) {
219908122e43SStefano Zampini       ierr = ISGetLocalSize(sub_schurs->is_Ej_com,&n_vertices);CHKERRQ(ierr);
220008122e43SStefano Zampini     }
220108122e43SStefano Zampini     max_constraints = 0;
220208122e43SStefano Zampini     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
220308122e43SStefano Zampini       total_counts += pcbddc->adaptive_constraints_n[i];
220408122e43SStefano Zampini       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
220508122e43SStefano Zampini     }
220608122e43SStefano Zampini     temp_indices = pcbddc->adaptive_constraints_ptrs;
220708122e43SStefano Zampini     temp_indices_to_constraint = pcbddc->adaptive_constraints_idxs;
220808122e43SStefano Zampini     temp_quadrature_constraint = pcbddc->adaptive_constraints_data;
220908122e43SStefano Zampini 
221008122e43SStefano Zampini #if 0
221108122e43SStefano Zampini     printf("Found %d totals\n",total_counts);
221208122e43SStefano Zampini     for (i=0;i<total_counts;i++) {
221308122e43SStefano Zampini       printf("const %d, start %d",i,temp_indices[i]);
221408122e43SStefano Zampini       printf(" end %d:\n",temp_indices[i+1]);
221508122e43SStefano Zampini       for (j=temp_indices[i];j<temp_indices[i+1];j++) {
221608122e43SStefano Zampini         printf("  idxs %d",temp_indices_to_constraint[j]);
221708122e43SStefano Zampini         printf("  data %1.2e\n",temp_quadrature_constraint[j]);
221808122e43SStefano Zampini       }
221908122e43SStefano Zampini     }
22201b968477SStefano Zampini     for (i=0;i<n_vertices;i++) {
22218bec7fa6SStefano Zampini       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
22221b968477SStefano Zampini     }
22231b968477SStefano Zampini     for (i=0;i<sub_schurs->n_subs;i++) {
22248bec7fa6SStefano 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]);
22251b968477SStefano Zampini     }
222608122e43SStefano Zampini #endif
222708122e43SStefano Zampini 
22288bec7fa6SStefano Zampini     max_size_of_constraint = 0;
222908122e43SStefano Zampini     for (i=0;i<total_counts;i++) max_size_of_constraint = PetscMax(max_size_of_constraint,temp_indices[i+1]-temp_indices[i]);
223008122e43SStefano Zampini     ierr = PetscMalloc1(temp_indices[total_counts],&temp_indices_to_constraint_B);CHKERRQ(ierr);
223108122e43SStefano Zampini     /* Change of basis */
223208122e43SStefano Zampini     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
223308122e43SStefano Zampini     if (pcbddc->use_change_of_basis) {
2234bbb9e6c6SStefano Zampini       cum = n_vertices;
223508122e43SStefano Zampini       for (i=0;i<sub_schurs->n_subs;i++) {
223608122e43SStefano Zampini         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
2237bbb9e6c6SStefano Zampini           for (j=0;j<pcbddc->adaptive_constraints_n[i+n_vertices];j++) {
223808122e43SStefano Zampini             ierr = PetscBTSet(change_basis,cum+j);CHKERRQ(ierr);
223908122e43SStefano Zampini           }
224008122e43SStefano Zampini         }
2241bbb9e6c6SStefano Zampini         cum += pcbddc->adaptive_constraints_n[i+n_vertices];
224208122e43SStefano Zampini       }
224308122e43SStefano Zampini     }
224408122e43SStefano Zampini   }
224508122e43SStefano Zampini 
224608122e43SStefano Zampini   /* map temp_indices_to_constraint in boundary numbering */
224708122e43SStefano Zampini   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,temp_indices[total_counts],temp_indices_to_constraint,&i,temp_indices_to_constraint_B);CHKERRQ(ierr);
224808122e43SStefano Zampini   if (i != temp_indices[total_counts]) {
224908122e43SStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for constraints indices %d != %d\n",temp_indices[total_counts],i);
225008122e43SStefano Zampini   }
2251984c4197SStefano Zampini 
2252727cdba6SStefano Zampini   /* set quantities in pcbddc data structure and store previous primal size */
2253984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
2254674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
2255984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
2256674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
2257984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
2258674ae819SStefano Zampini 
2259674ae819SStefano Zampini   /* Create constraint matrix */
2260674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
2261674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
2262674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
226316f15bc4SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
2264984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
2265984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
2266785e854fSJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&aux_primal_numbering);CHKERRQ(ierr);
22674641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n_B,&touched);CHKERRQ(ierr);
2268984c4197SStefano Zampini 
2269984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
2270984c4197SStefano Zampini   total_primal_vertices=0;
2271984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
2272674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
2273984c4197SStefano Zampini     if (size_of_constraint == 1) {
22744641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]]);CHKERRQ(ierr);
2275984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]];
2276984c4197SStefano Zampini       total_primal_vertices++;
22774641a718SStefano Zampini     } else if (PetscBTLookup(change_basis,i)) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */
2278*bc804489SStefano 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++;
2281*bc804489SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+k]);CHKERRQ(ierr);
2282*bc804489SStefano Zampini       aux_primal_numbering[total_primal_vertices++]=temp_indices_to_constraint[temp_indices[i]+k];
2283984c4197SStefano Zampini     }
2284984c4197SStefano Zampini   }
2285a717540cSStefano Zampini   /* determine if a QR strategy is needed for change of basis */
2286a717540cSStefano Zampini   qr_needed = PETSC_FALSE;
2287a717540cSStefano Zampini   ierr = PetscBTCreate(pcbddc->local_primal_size,&qr_needed_idx);CHKERRQ(ierr);
2288a717540cSStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
2289a717540cSStefano Zampini     if (PetscBTLookup(change_basis,i)) {
2290ac632422SStefano Zampini       if (!pcbddc->use_qr_single && !pcbddc->faster_deluxe) {
2291a717540cSStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
2292a717540cSStefano Zampini         j = 0;
2293a717540cSStefano Zampini         for (k=0;k<size_of_constraint;k++) {
2294a717540cSStefano Zampini           if (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) {
2295a717540cSStefano Zampini             j++;
2296a717540cSStefano Zampini           }
2297a717540cSStefano Zampini         }
2298a717540cSStefano Zampini         /* found more than one primal dof on the cc */
2299a717540cSStefano Zampini         if (j > 1) {
2300a717540cSStefano Zampini           PetscBTSet(qr_needed_idx,i);
2301a717540cSStefano Zampini           qr_needed = PETSC_TRUE;
2302a717540cSStefano Zampini         }
2303fa434743SStefano Zampini       } else {
2304fa434743SStefano Zampini         PetscBTSet(qr_needed_idx,i);
2305fa434743SStefano Zampini         qr_needed = PETSC_TRUE;
2306fa434743SStefano Zampini       }
2307a717540cSStefano Zampini     }
2308a717540cSStefano Zampini   }
2309088faed8SStefano Zampini   total_counts = total_primal_vertices;
2310088faed8SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
2311088faed8SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
2312088faed8SStefano Zampini     if (size_of_constraint != 1 && !PetscBTLookup(change_basis,i)) {
2313*bc804489SStefano Zampini       /* find first (by global ordering) untouched node in the cc */
2314088faed8SStefano Zampini       k = 0;
2315088faed8SStefano Zampini       while (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) k++;
2316*bc804489SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+k]);CHKERRQ(ierr);
2317*bc804489SStefano Zampini       aux_primal_numbering[total_counts++]=temp_indices_to_constraint[temp_indices[i]+k];
2318088faed8SStefano Zampini     }
2319088faed8SStefano Zampini   }
232045a1bb75SStefano Zampini 
2321674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
2322a717540cSStefano Zampini   ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering);CHKERRQ(ierr);
2323984c4197SStefano Zampini 
2324088faed8SStefano Zampini   /* get reference dofs for local primal dofs */
2325088faed8SStefano Zampini   ierr = PetscMalloc1(pcbddc->local_primal_size,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
2326088faed8SStefano Zampini   ierr = PetscMemcpy(pcbddc->primal_indices_local_idxs,aux_primal_numbering,pcbddc->local_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
2327088faed8SStefano Zampini   pcbddc->n_actual_vertices = total_primal_vertices;
2328088faed8SStefano Zampini 
2329984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
2330785e854fSJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
2331984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
2332984c4197SStefano Zampini   j=total_primal_vertices;
2333984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
23344641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
2335674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
2336674ae819SStefano Zampini       j++;
2337674ae819SStefano Zampini     }
2338674ae819SStefano Zampini   }
2339674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
2340674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
2341088faed8SStefano Zampini 
2342674ae819SStefano Zampini   /* set values in constraint matrix */
2343984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
2344984c4197SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
2345674ae819SStefano Zampini   }
2346984c4197SStefano Zampini   total_counts = total_primal_vertices;
2347984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
23484641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
2349674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
2350674ae819SStefano 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);
2351674ae819SStefano Zampini       total_counts++;
2352674ae819SStefano Zampini     }
2353674ae819SStefano Zampini   }
2354674ae819SStefano Zampini   /* assembling */
2355674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2356674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2357088faed8SStefano Zampini 
2358984c4197SStefano Zampini   /*
235945a1bb75SStefano Zampini   ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
2360984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
2361984c4197SStefano Zampini   */
2362674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
2363674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
2364026de310SStefano Zampini     /* dual and primal dofs on a single cc */
2365984c4197SStefano Zampini     PetscInt     dual_dofs,primal_dofs;
2366984c4197SStefano Zampini     /* working stuff for GEQRF */
236781d9aea3SBarry Smith     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
2368984c4197SStefano Zampini     PetscBLASInt lqr_work;
2369984c4197SStefano Zampini     /* working stuff for UNGQR */
2370984c4197SStefano Zampini     PetscScalar  *gqr_work,lgqr_work_t;
2371984c4197SStefano Zampini     PetscBLASInt lgqr_work;
2372984c4197SStefano Zampini     /* working stuff for TRTRS */
2373984c4197SStefano Zampini     PetscScalar  *trs_rhs;
23743f08241aSStefano Zampini     PetscBLASInt Blas_NRHS;
2375984c4197SStefano Zampini     /* pointers for values insertion into change of basis matrix */
2376984c4197SStefano Zampini     PetscInt     *start_rows,*start_cols;
2377984c4197SStefano Zampini     PetscScalar  *start_vals;
2378984c4197SStefano Zampini     /* working stuff for values insertion */
23794641a718SStefano Zampini     PetscBT      is_primal;
2380906d46d4SStefano Zampini     /* matrix sizes */
2381906d46d4SStefano Zampini     PetscInt     global_size,local_size;
2382906d46d4SStefano Zampini     /* temporary change of basis */
2383906d46d4SStefano Zampini     Mat          localChangeOfBasisMatrix;
2384cf5a6209SStefano Zampini     /* extra space for debugging */
2385cf5a6209SStefano Zampini     PetscScalar  *dbg_work;
2386984c4197SStefano Zampini 
2387906d46d4SStefano Zampini     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
2388906d46d4SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
238916f15bc4SStefano Zampini     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
2390bbb9e6c6SStefano Zampini     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
2391906d46d4SStefano Zampini     /* nonzeros for local mat */
2392bbb9e6c6SStefano Zampini     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
2393bbb9e6c6SStefano Zampini     for (i=0;i<pcis->n;i++) nnz[i]=1;
2394a717540cSStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
2395a717540cSStefano Zampini       if (PetscBTLookup(change_basis,i)) {
2396a717540cSStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
2397a717540cSStefano Zampini         if (PetscBTLookup(qr_needed_idx,i)) {
2398bbb9e6c6SStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint[temp_indices[i]+j]] = size_of_constraint;
2399a717540cSStefano Zampini         } else {
2400bbb9e6c6SStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint[temp_indices[i]+j]] = 2;
2401a717540cSStefano Zampini           /* get local primal index on the cc */
2402a717540cSStefano Zampini           j = 0;
2403a717540cSStefano Zampini           while (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+j])) j++;
2404bbb9e6c6SStefano Zampini           nnz[temp_indices_to_constraint[temp_indices[i]+j]] = size_of_constraint;
2405a717540cSStefano Zampini         }
2406a717540cSStefano Zampini       }
2407a717540cSStefano Zampini     }
2408906d46d4SStefano Zampini     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
2409bbb9e6c6SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
2410a717540cSStefano Zampini     /* Set initial identity in the matrix */
2411bbb9e6c6SStefano Zampini     for (i=0;i<pcis->n;i++) {
2412906d46d4SStefano Zampini       ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
2413a717540cSStefano Zampini     }
2414a717540cSStefano Zampini 
2415a717540cSStefano Zampini     if (pcbddc->dbg_flag) {
2416a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
2417a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
2418a717540cSStefano Zampini     }
2419a717540cSStefano Zampini 
2420a717540cSStefano Zampini 
2421a717540cSStefano Zampini     /* Now we loop on the constraints which need a change of basis */
2422a717540cSStefano Zampini     /*
2423a717540cSStefano Zampini        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
2424a717540cSStefano Zampini        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
2425a717540cSStefano Zampini 
2426a6b551f4SStefano Zampini        Basic blocks of change of basis matrix T computed by
2427a717540cSStefano Zampini 
2428a6b551f4SStefano 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)
2429a6b551f4SStefano Zampini 
2430a6b551f4SStefano Zampini             | 1        0   ...        0         s_1/S |
2431a6b551f4SStefano Zampini             | 0        1   ...        0         s_2/S |
2432a717540cSStefano Zampini             |              ...                        |
2433a6b551f4SStefano Zampini             | 0        ...            1     s_{n-1}/S |
2434a6b551f4SStefano Zampini             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
2435a717540cSStefano Zampini 
2436a6b551f4SStefano Zampini             with S = \sum_{i=1}^n s_i^2
2437a6b551f4SStefano Zampini             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
2438a6b551f4SStefano Zampini                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
2439a6b551f4SStefano Zampini 
2440a6b551f4SStefano Zampini           - QR decomposition of constraints otherwise
2441a717540cSStefano Zampini     */
2442a717540cSStefano Zampini     if (qr_needed) {
2443984c4197SStefano Zampini       /* space to store Q */
2444854ce69bSBarry Smith       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
2445984c4197SStefano Zampini       /* first we issue queries for optimal work */
24463f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
24473f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
24483f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2449984c4197SStefano Zampini       lqr_work = -1;
24503f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
2451984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
2452984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
2453785e854fSJed Brown       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
2454984c4197SStefano Zampini       lgqr_work = -1;
24553f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
24563f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
24573f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
24583f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
24593f08241aSStefano Zampini       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
24603f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
2461984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
2462984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
2463785e854fSJed Brown       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
2464984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
2465785e854fSJed Brown       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
2466984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
2467785e854fSJed Brown       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
2468a717540cSStefano Zampini       /* allocating workspace for check */
2469a717540cSStefano Zampini       if (pcbddc->dbg_flag) {
2470cf5a6209SStefano Zampini         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
2471a717540cSStefano Zampini       }
2472a717540cSStefano Zampini     }
2473984c4197SStefano Zampini     /* array to store whether a node is primal or not */
24744641a718SStefano Zampini     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
2475473ba861SJed Brown     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
24765e8657edSStefano Zampini     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,aux_primal_numbering,&i,aux_primal_numbering_B);CHKERRQ(ierr);
247739e2fb2aSStefano Zampini     if (i != total_primal_vertices) {
247839e2fb2aSStefano Zampini       SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",total_primal_vertices,i);
24794641a718SStefano Zampini     }
248039e2fb2aSStefano Zampini     for (i=0;i<total_primal_vertices;i++) {
248139e2fb2aSStefano Zampini       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
248239e2fb2aSStefano Zampini     }
248339e2fb2aSStefano Zampini     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
2484984c4197SStefano Zampini 
2485a717540cSStefano Zampini     /* loop on constraints and see whether or not they need a change of basis and compute it */
2486026de310SStefano Zampini     /* -> using implicit ordering contained in temp_indices data */
2487026de310SStefano Zampini     total_counts = pcbddc->n_vertices;
2488026de310SStefano Zampini     while (total_counts<pcbddc->local_primal_size) {
2489026de310SStefano Zampini       primal_dofs = 1;
24904641a718SStefano Zampini       if (PetscBTLookup(change_basis,total_counts)) {
2491026de310SStefano Zampini         /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
2492bbb9e6c6SStefano 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]]) {
2493026de310SStefano Zampini           primal_dofs++;
2494674ae819SStefano Zampini         }
2495984c4197SStefano Zampini         /* get constraint info */
2496026de310SStefano Zampini         size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
2497984c4197SStefano Zampini         dual_dofs = size_of_constraint-primal_dofs;
2498984c4197SStefano Zampini 
2499984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
2500a717540cSStefano 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);
2501674ae819SStefano Zampini         }
2502984c4197SStefano Zampini 
2503fa434743SStefano Zampini         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
2504a717540cSStefano Zampini 
2505a717540cSStefano Zampini           /* copy quadrature constraints for change of basis check */
2506a717540cSStefano Zampini           if (pcbddc->dbg_flag) {
2507cf5a6209SStefano Zampini             ierr = PetscMemcpy(dbg_work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
2508a717540cSStefano Zampini           }
2509984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
2510026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
2511984c4197SStefano Zampini 
2512984c4197SStefano Zampini           /* compute QR decomposition of constraints */
25133f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
25143f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
25153f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2516674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
25173f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
2518984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
2519674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2520984c4197SStefano Zampini 
2521984c4197SStefano Zampini           /* explictly compute R^-T */
2522984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
2523984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
25243f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
25253f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
25263f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
25273f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
2528984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
25293f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
2530984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
2531984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2532984c4197SStefano Zampini 
2533a717540cSStefano Zampini           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
25343f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
25353f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
25363f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
25373f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2538984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
25393f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
2540984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
2541984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2542984c4197SStefano Zampini 
2543984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
2544984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
2545984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
25463f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
25473f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
25483f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
25493f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
25503f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
25513f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
2552984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2553c4303822SStefano 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));
2554984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2555026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
2556984c4197SStefano Zampini 
2557984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
2558bbb9e6c6SStefano Zampini           start_rows = &temp_indices_to_constraint[temp_indices[total_counts]];
2559984c4197SStefano Zampini           /* insert cols for primal dofs */
2560984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
2561984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
2562*bc804489SStefano Zampini             start_cols = &temp_indices_to_constraint[temp_indices[total_counts]+j];
2563906d46d4SStefano Zampini             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
2564984c4197SStefano Zampini           }
2565984c4197SStefano Zampini           /* insert cols for dual dofs */
2566984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
25674641a718SStefano Zampini             if (!PetscBTLookup(is_primal,temp_indices_to_constraint_B[temp_indices[total_counts]+k])) {
2568984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
2569bbb9e6c6SStefano Zampini               start_cols = &temp_indices_to_constraint[temp_indices[total_counts]+k];
2570906d46d4SStefano Zampini               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
2571984c4197SStefano Zampini               j++;
2572674ae819SStefano Zampini             }
2573674ae819SStefano Zampini           }
2574984c4197SStefano Zampini 
2575984c4197SStefano Zampini           /* check change of basis */
2576984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
2577984c4197SStefano Zampini             PetscInt   ii,jj;
2578984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
2579c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
2580c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2581c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
2582c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2583c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
2584c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
2585984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2586cf5a6209SStefano 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));
2587984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
2588984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
2589984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
2590cf5a6209SStefano Zampini                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
2591cf5a6209SStefano 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;
2592674ae819SStefano Zampini               }
2593674ae819SStefano Zampini             }
2594984c4197SStefano Zampini             if (!valid_qr) {
259522d5777bSStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
2596984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
2597984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
2598cf5a6209SStefano Zampini                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
2599cf5a6209SStefano 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]));
2600674ae819SStefano Zampini                   }
2601cf5a6209SStefano Zampini                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
2602cf5a6209SStefano 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]));
2603984c4197SStefano Zampini                   }
2604984c4197SStefano Zampini                 }
2605984c4197SStefano Zampini               }
2606674ae819SStefano Zampini             } else {
260722d5777bSStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
2608674ae819SStefano Zampini             }
2609674ae819SStefano Zampini           }
2610a717540cSStefano Zampini         } else { /* simple transformation block */
2611a717540cSStefano Zampini           PetscInt    row,col;
2612a6b551f4SStefano Zampini           PetscScalar val,norm;
2613a6b551f4SStefano Zampini 
2614a6b551f4SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2615a6b551f4SStefano 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));
2616a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
2617bbb9e6c6SStefano Zampini             PetscInt row_B = temp_indices_to_constraint_B[temp_indices[total_counts]+j];
2618bbb9e6c6SStefano Zampini             row = temp_indices_to_constraint[temp_indices[total_counts]+j];
2619bbb9e6c6SStefano Zampini             if (!PetscBTLookup(is_primal,row_B)) {
2620*bc804489SStefano Zampini               col = temp_indices_to_constraint[temp_indices[total_counts]];
2621906d46d4SStefano Zampini               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
2622a6b551f4SStefano Zampini               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,temp_quadrature_constraint[temp_indices[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
2623a717540cSStefano Zampini             } else {
2624a717540cSStefano Zampini               for (k=0;k<size_of_constraint;k++) {
2625bbb9e6c6SStefano Zampini                 col = temp_indices_to_constraint[temp_indices[total_counts]+k];
2626a717540cSStefano Zampini                 if (row != col) {
2627*bc804489SStefano Zampini                   val = -temp_quadrature_constraint[temp_indices[total_counts]+k]/temp_quadrature_constraint[temp_indices[total_counts]];
2628a717540cSStefano Zampini                 } else {
2629*bc804489SStefano Zampini                   val = temp_quadrature_constraint[temp_indices[total_counts]]/norm;
2630a717540cSStefano Zampini                 }
2631906d46d4SStefano Zampini                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
2632a717540cSStefano Zampini               }
2633a717540cSStefano Zampini             }
2634a717540cSStefano Zampini           }
263598a51de6SStefano Zampini           if (pcbddc->dbg_flag) {
263622d5777bSStefano Zampini             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
2637a717540cSStefano Zampini           }
2638674ae819SStefano Zampini         }
2639984c4197SStefano Zampini       } else {
2640984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
2641026de310SStefano 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);
2642674ae819SStefano Zampini         }
2643674ae819SStefano Zampini       }
2644026de310SStefano Zampini       /* increment constraint counter total_counts */
2645026de310SStefano Zampini       total_counts += primal_dofs;
2646674ae819SStefano Zampini     }
2647a717540cSStefano Zampini 
2648a717540cSStefano Zampini     /* free workspace */
2649a717540cSStefano Zampini     if (qr_needed) {
2650984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
2651cf5a6209SStefano Zampini         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
2652984c4197SStefano Zampini       }
2653984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
2654984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
2655984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
2656984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
2657984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
2658674ae819SStefano Zampini     }
2659a717540cSStefano Zampini     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
2660906d46d4SStefano Zampini     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2661906d46d4SStefano Zampini     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2662906d46d4SStefano Zampini 
2663906d46d4SStefano Zampini     /* assembling of global change of variable */
2664bbb9e6c6SStefano Zampini     {
2665bbb9e6c6SStefano Zampini       Mat      tmat;
266616f15bc4SStefano Zampini       PetscInt bs;
266716f15bc4SStefano Zampini 
2668906d46d4SStefano Zampini       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
2669906d46d4SStefano Zampini       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
2670bbb9e6c6SStefano Zampini       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
2671bbb9e6c6SStefano Zampini       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
2672bbb9e6c6SStefano Zampini       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
2673bbb9e6c6SStefano Zampini       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
267416f15bc4SStefano Zampini       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
267516f15bc4SStefano Zampini       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
2676906d46d4SStefano Zampini       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
2677bbb9e6c6SStefano Zampini       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
2678bbb9e6c6SStefano Zampini       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
2679bbb9e6c6SStefano Zampini       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
2680bbb9e6c6SStefano Zampini       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
2681bbb9e6c6SStefano Zampini       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
2682bbb9e6c6SStefano Zampini       ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2683bbb9e6c6SStefano Zampini       ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2684bbb9e6c6SStefano Zampini       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
2685bbb9e6c6SStefano Zampini       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
2686906d46d4SStefano Zampini     }
2687906d46d4SStefano Zampini     /* check */
2688906d46d4SStefano Zampini     if (pcbddc->dbg_flag) {
2689906d46d4SStefano Zampini       PetscReal error;
2690906d46d4SStefano Zampini       Vec       x,x_change;
2691906d46d4SStefano Zampini 
2692906d46d4SStefano Zampini       ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
2693906d46d4SStefano Zampini       ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
2694906d46d4SStefano Zampini       ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
2695906d46d4SStefano Zampini       ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
2696bbb9e6c6SStefano Zampini       ierr = VecScatterBegin(matis->ctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2697bbb9e6c6SStefano Zampini       ierr = VecScatterEnd(matis->ctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2698bbb9e6c6SStefano Zampini       ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
2699bbb9e6c6SStefano Zampini       ierr = VecScatterBegin(matis->ctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2700bbb9e6c6SStefano Zampini       ierr = VecScatterEnd(matis->ctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2701906d46d4SStefano Zampini       ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
2702906d46d4SStefano Zampini       ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
2703906d46d4SStefano Zampini       ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
2704906d46d4SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2705bbb9e6c6SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Error global vs local change: %1.6e\n",error);CHKERRQ(ierr);
2706906d46d4SStefano Zampini       ierr = VecDestroy(&x);CHKERRQ(ierr);
2707906d46d4SStefano Zampini       ierr = VecDestroy(&x_change);CHKERRQ(ierr);
2708906d46d4SStefano Zampini     }
2709b96c3477SStefano Zampini 
2710b96c3477SStefano Zampini     /* adapt sub_schurs computed (if any) */
2711b96c3477SStefano Zampini     if (pcbddc->use_deluxe_scaling) {
2712b96c3477SStefano Zampini       PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
2713b96c3477SStefano Zampini       if (sub_schurs->S_Ej_all) {
2714ac632422SStefano Zampini         Mat S_new,tmat;
2715bbb9e6c6SStefano Zampini         IS is_all_N;
2716bbb9e6c6SStefano Zampini 
2717bbb9e6c6SStefano Zampini         ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
2718d648f858SStefano Zampini         ierr = MatGetSubMatrixUnsorted(localChangeOfBasisMatrix,is_all_N,is_all_N,&tmat);CHKERRQ(ierr);
2719bbb9e6c6SStefano Zampini         ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
2720ac632422SStefano Zampini         ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
2721b96c3477SStefano Zampini         ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
2722ac632422SStefano Zampini         ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
2723ac632422SStefano Zampini         sub_schurs->S_Ej_all = S_new;
2724ac632422SStefano Zampini         ierr = MatDestroy(&S_new);CHKERRQ(ierr);
2725ac632422SStefano Zampini         if (sub_schurs->sum_S_Ej_all) {
2726ac632422SStefano Zampini           ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
2727b96c3477SStefano Zampini           ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
2728ac632422SStefano Zampini           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
2729ac632422SStefano Zampini           sub_schurs->sum_S_Ej_all = S_new;
2730ac632422SStefano Zampini           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
2731ac632422SStefano Zampini         }
2732b96c3477SStefano Zampini         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
2733b96c3477SStefano Zampini       }
2734b96c3477SStefano Zampini     }
2735906d46d4SStefano Zampini     ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
2736906d46d4SStefano Zampini   } else if (pcbddc->user_ChangeOfBasisMatrix) {
2737b9b85e73SStefano Zampini     ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
2738b9b85e73SStefano Zampini     pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
2739b9b85e73SStefano Zampini   }
2740906d46d4SStefano Zampini 
2741906d46d4SStefano Zampini   /* set up change of basis context */
2742906d46d4SStefano Zampini   if (pcbddc->ChangeOfBasisMatrix) {
2743906d46d4SStefano Zampini     PCBDDCChange_ctx change_ctx;
2744906d46d4SStefano Zampini 
2745906d46d4SStefano Zampini     if (!pcbddc->new_global_mat) {
2746906d46d4SStefano Zampini       PetscInt global_size,local_size;
2747906d46d4SStefano Zampini 
2748906d46d4SStefano Zampini       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
2749906d46d4SStefano Zampini       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
2750906d46d4SStefano Zampini       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->new_global_mat);CHKERRQ(ierr);
2751906d46d4SStefano Zampini       ierr = MatSetSizes(pcbddc->new_global_mat,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
2752906d46d4SStefano Zampini       ierr = MatSetType(pcbddc->new_global_mat,MATSHELL);CHKERRQ(ierr);
2753906d46d4SStefano Zampini       ierr = MatShellSetOperation(pcbddc->new_global_mat,MATOP_MULT,(void (*)(void))PCBDDCMatMult_Private);CHKERRQ(ierr);
2754906d46d4SStefano Zampini       ierr = MatShellSetOperation(pcbddc->new_global_mat,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCMatMultTranspose_Private);CHKERRQ(ierr);
2755906d46d4SStefano Zampini       ierr = PetscNew(&change_ctx);CHKERRQ(ierr);
2756906d46d4SStefano Zampini       ierr = MatShellSetContext(pcbddc->new_global_mat,change_ctx);CHKERRQ(ierr);
2757906d46d4SStefano Zampini     } else {
2758906d46d4SStefano Zampini       ierr = MatShellGetContext(pcbddc->new_global_mat,&change_ctx);CHKERRQ(ierr);
2759906d46d4SStefano Zampini       ierr = MatDestroy(&change_ctx->global_change);CHKERRQ(ierr);
2760906d46d4SStefano Zampini       ierr = VecDestroyVecs(2,&change_ctx->work);CHKERRQ(ierr);
2761906d46d4SStefano Zampini     }
2762906d46d4SStefano Zampini     if (!pcbddc->user_ChangeOfBasisMatrix) {
2763906d46d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
2764906d46d4SStefano Zampini       change_ctx->global_change = pcbddc->ChangeOfBasisMatrix;
2765906d46d4SStefano Zampini     } else {
2766906d46d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
2767906d46d4SStefano Zampini       change_ctx->global_change = pcbddc->user_ChangeOfBasisMatrix;
2768906d46d4SStefano Zampini     }
2769906d46d4SStefano Zampini     ierr = VecDuplicateVecs(pcis->vec1_global,2,&change_ctx->work);CHKERRQ(ierr);
2770906d46d4SStefano Zampini     ierr = MatSetUp(pcbddc->new_global_mat);CHKERRQ(ierr);
2771906d46d4SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->new_global_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2772906d46d4SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->new_global_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2773b9b85e73SStefano Zampini   }
2774a717540cSStefano Zampini 
2775727cdba6SStefano Zampini   /* get indices in local ordering for vertices and constraints */
2776727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2777088faed8SStefano Zampini 
2778727cdba6SStefano Zampini   /* check if a new primal space has been introduced */
2779727cdba6SStefano Zampini   pcbddc->new_primal_space_local = PETSC_TRUE;
2780727cdba6SStefano Zampini   if (olocal_primal_size == pcbddc->local_primal_size) {
2781727cdba6SStefano Zampini     ierr = PetscMemcmp(pcbddc->primal_indices_local_idxs,oprimal_indices_local_idxs,olocal_primal_size,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
2782c1c8e736SStefano Zampini     pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
2783727cdba6SStefano Zampini   }
2784088faed8SStefano Zampini   ierr = PetscFree(oprimal_indices_local_idxs);CHKERRQ(ierr);
2785727cdba6SStefano Zampini   /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
2786727cdba6SStefano Zampini   ierr = MPI_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2787727cdba6SStefano Zampini 
2788a717540cSStefano Zampini   /* flush dbg viewer */
2789b8ffe317SStefano Zampini   if (pcbddc->dbg_flag) {
2790b8ffe317SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2791b8ffe317SStefano Zampini   }
2792a717540cSStefano Zampini 
2793e310c8b4SStefano Zampini   /* free workspace */
2794a717540cSStefano Zampini   ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2795a717540cSStefano Zampini   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
27964641a718SStefano Zampini   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
279708122e43SStefano Zampini   if (!pcbddc->adaptive_selection) {
2798906d46d4SStefano Zampini     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
2799906d46d4SStefano Zampini     ierr = PetscFree3(temp_quadrature_constraint,temp_indices_to_constraint,temp_indices_to_constraint_B);CHKERRQ(ierr);
280008122e43SStefano Zampini   } else {
280108122e43SStefano Zampini     ierr = PetscFree4(pcbddc->adaptive_constraints_n,
280208122e43SStefano Zampini                       pcbddc->adaptive_constraints_ptrs,
280308122e43SStefano Zampini                       pcbddc->adaptive_constraints_idxs,
280408122e43SStefano Zampini                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
280508122e43SStefano Zampini     ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
280608122e43SStefano Zampini   }
2807674ae819SStefano Zampini   PetscFunctionReturn(0);
2808674ae819SStefano Zampini }
2809674ae819SStefano Zampini 
2810674ae819SStefano Zampini #undef __FUNCT__
2811674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
2812674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
2813674ae819SStefano Zampini {
2814674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
2815674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
2816674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
28177fb0e2dbSStefano Zampini   PetscInt    ierr,i,vertex_size,N;
2818674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
2819674ae819SStefano Zampini 
2820674ae819SStefano Zampini   PetscFunctionBegin;
28218e61c736SStefano Zampini   /* Reset previously computed graph */
28228e61c736SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
2823674ae819SStefano Zampini   /* Init local Graph struct */
28247fb0e2dbSStefano Zampini   ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
28257fb0e2dbSStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping,N);CHKERRQ(ierr);
2826674ae819SStefano Zampini 
2827575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
2828575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
2829575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
2830575ad6abSStefano Zampini   }
28319577ea80SStefano Zampini 
2832674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
28334d379d7bSStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
28344d379d7bSStefano Zampini     PetscInt  *xadj,*adjncy;
28354d379d7bSStefano Zampini     PetscInt  nvtxs;
2836e496cd5dSStefano Zampini     PetscBool flg_row=PETSC_FALSE;
2837674ae819SStefano Zampini 
28384d379d7bSStefano Zampini     if (pcbddc->use_local_adj) {
28392fffb893SStefano Zampini 
28402fffb893SStefano Zampini       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
28412fffb893SStefano Zampini       if (flg_row) {
28424d379d7bSStefano Zampini         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
2843b96c3477SStefano Zampini         pcbddc->computed_rowadj = PETSC_TRUE;
28442fffb893SStefano Zampini       }
28452fffb893SStefano Zampini       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
28469b28b941SStefano 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 */
28474d379d7bSStefano Zampini       IS                     is_dummy;
28484d379d7bSStefano Zampini       ISLocalToGlobalMapping l2gmap_dummy;
28494d379d7bSStefano Zampini       PetscInt               j,sum;
28504d379d7bSStefano Zampini       PetscInt               *cxadj,*cadjncy;
28514d379d7bSStefano Zampini       const PetscInt         *idxs;
28524d379d7bSStefano Zampini       PCBDDCGraph            graph;
28534d379d7bSStefano Zampini       PetscBT                is_on_boundary;
28544d379d7bSStefano Zampini 
28554d379d7bSStefano Zampini       ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n,0,1,&is_dummy);CHKERRQ(ierr);
28564d379d7bSStefano Zampini       ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
28574d379d7bSStefano Zampini       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
28584d379d7bSStefano Zampini       ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
28597fb0e2dbSStefano Zampini       ierr = PCBDDCGraphInit(graph,l2gmap_dummy,pcis->n);CHKERRQ(ierr);
28604d379d7bSStefano Zampini       ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2861e496cd5dSStefano Zampini       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2862e496cd5dSStefano Zampini       if (flg_row) {
28634d379d7bSStefano Zampini         graph->xadj = xadj;
28644d379d7bSStefano Zampini         graph->adjncy = adjncy;
2865e496cd5dSStefano Zampini       }
28664d379d7bSStefano Zampini       ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
28674d379d7bSStefano Zampini       ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2868e496cd5dSStefano Zampini       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
28694d379d7bSStefano Zampini 
28704d379d7bSStefano Zampini       if (pcbddc->dbg_flag) {
28719b28b941SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"[%d] Found %d subdomains (local size %d)\n",PetscGlobalRank,graph->ncc,pcis->n);CHKERRQ(ierr);
28724d379d7bSStefano Zampini         for (i=0;i<graph->ncc;i++) {
28734d379d7bSStefano Zampini           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"[%d] %d cc size %d\n",PetscGlobalRank,i,graph->cptr[i+1]-graph->cptr[i]);CHKERRQ(ierr);
28744d379d7bSStefano Zampini         }
28754d379d7bSStefano Zampini       }
28764d379d7bSStefano Zampini 
2877e496cd5dSStefano Zampini       ierr = PetscBTCreate(pcis->n,&is_on_boundary);CHKERRQ(ierr);
28784d379d7bSStefano Zampini       ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
28794d379d7bSStefano Zampini       for (i=0;i<pcis->n_B;i++) {
28804d379d7bSStefano Zampini         ierr = PetscBTSet(is_on_boundary,idxs[i]);CHKERRQ(ierr);
28814d379d7bSStefano Zampini       }
28824d379d7bSStefano Zampini       ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
28834d379d7bSStefano Zampini 
2884e496cd5dSStefano Zampini       ierr = PetscCalloc1(pcis->n+1,&cxadj);CHKERRQ(ierr);
28854d379d7bSStefano Zampini       sum = 0;
28864d379d7bSStefano Zampini       for (i=0;i<graph->ncc;i++) {
28874d379d7bSStefano Zampini         PetscInt sizecc = 0;
28884d379d7bSStefano Zampini         for (j=graph->cptr[i];j<graph->cptr[i+1];j++) {
28894d379d7bSStefano Zampini           if (PetscBTLookup(is_on_boundary,graph->queue[j])) {
28904d379d7bSStefano Zampini             sizecc++;
28914d379d7bSStefano Zampini           }
28924d379d7bSStefano Zampini         }
28934d379d7bSStefano Zampini         for (j=graph->cptr[i];j<graph->cptr[i+1];j++) {
28944d379d7bSStefano Zampini           if (PetscBTLookup(is_on_boundary,graph->queue[j])) {
28954d379d7bSStefano Zampini             cxadj[graph->queue[j]] = sizecc;
28964d379d7bSStefano Zampini           }
28974d379d7bSStefano Zampini         }
28984d379d7bSStefano Zampini         sum += sizecc*sizecc;
28994d379d7bSStefano Zampini       }
29004d379d7bSStefano Zampini       ierr = PetscMalloc1(sum,&cadjncy);CHKERRQ(ierr);
29014d379d7bSStefano Zampini       sum = 0;
2902e496cd5dSStefano Zampini       for (i=0;i<pcis->n;i++) {
29034d379d7bSStefano Zampini         PetscInt temp = cxadj[i];
29044d379d7bSStefano Zampini         cxadj[i] = sum;
29054d379d7bSStefano Zampini         sum += temp;
29064d379d7bSStefano Zampini       }
2907e496cd5dSStefano Zampini       cxadj[pcis->n] = sum;
29084d379d7bSStefano Zampini       for (i=0;i<graph->ncc;i++) {
29094d379d7bSStefano Zampini         for (j=graph->cptr[i];j<graph->cptr[i+1];j++) {
29104d379d7bSStefano Zampini           if (PetscBTLookup(is_on_boundary,graph->queue[j])) {
29114d379d7bSStefano Zampini             PetscInt k,sizecc = 0;
29124d379d7bSStefano Zampini             for (k=graph->cptr[i];k<graph->cptr[i+1];k++) {
29134d379d7bSStefano Zampini               if (PetscBTLookup(is_on_boundary,graph->queue[k])) {
29144d379d7bSStefano Zampini                 cadjncy[cxadj[graph->queue[j]]+sizecc]=graph->queue[k];
29154d379d7bSStefano Zampini                 sizecc++;
29164d379d7bSStefano Zampini               }
29174d379d7bSStefano Zampini             }
29184d379d7bSStefano Zampini           }
29194d379d7bSStefano Zampini         }
29204d379d7bSStefano Zampini       }
29219b28b941SStefano Zampini       if (sum) {
2922e496cd5dSStefano Zampini         ierr = PCBDDCSetLocalAdjacencyGraph(pc,pcis->n,cxadj,cadjncy,PETSC_OWN_POINTER);CHKERRQ(ierr);
29234d379d7bSStefano Zampini       } else {
29244d379d7bSStefano Zampini         ierr = PetscFree(cxadj);CHKERRQ(ierr);
29254d379d7bSStefano Zampini         ierr = PetscFree(cadjncy);CHKERRQ(ierr);
29264d379d7bSStefano Zampini       }
29274d379d7bSStefano Zampini       graph->xadj = 0;
29284d379d7bSStefano Zampini       graph->adjncy = 0;
29294d379d7bSStefano Zampini       ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
29304d379d7bSStefano Zampini       ierr = PetscBTDestroy(&is_on_boundary);CHKERRQ(ierr);
29314d379d7bSStefano Zampini     }
2932674ae819SStefano Zampini   }
29339b28b941SStefano Zampini   if (pcbddc->dbg_flag) {
29349b28b941SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
29359b28b941SStefano Zampini   }
2936674ae819SStefano Zampini 
293763602bcaSStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting or PCBDDCSetDofsSplittingLocal */
2938674ae819SStefano Zampini   vertex_size = 1;
293963602bcaSStefano Zampini   if (pcbddc->user_provided_isfordofs) {
294063602bcaSStefano Zampini     if (pcbddc->n_ISForDofs) { /* need to convert from global to local and remove references to global dofs splitting */
294195ecbf38SStefano Zampini       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
294263602bcaSStefano Zampini       for (i=0;i<pcbddc->n_ISForDofs;i++) {
2943a7dc3881SStefano Zampini         ierr = PCBDDCGlobalToLocal(matis->ctx,pcis->vec1_global,pcis->vec1_N,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
294463602bcaSStefano Zampini         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
2945674ae819SStefano Zampini       }
294663602bcaSStefano Zampini       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
294763602bcaSStefano Zampini       pcbddc->n_ISForDofs = 0;
294863602bcaSStefano Zampini       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
2949674ae819SStefano Zampini     }
295063602bcaSStefano Zampini     /* mat block size as vertex size (used for elasticity with rigid body modes as nearnullspace) */
2951674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
295263602bcaSStefano Zampini   } else {
295363602bcaSStefano Zampini     if (!pcbddc->n_ISForDofsLocal) { /* field split not present, create it in local ordering */
295463602bcaSStefano Zampini       ierr = MatGetBlockSize(pc->pmat,&pcbddc->n_ISForDofsLocal);CHKERRQ(ierr);
2955854ce69bSBarry Smith       ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
295663602bcaSStefano Zampini       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
295763602bcaSStefano Zampini         ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),pcis->n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
295863602bcaSStefano Zampini       }
295963602bcaSStefano Zampini     }
2960674ae819SStefano Zampini   }
2961674ae819SStefano Zampini 
2962674ae819SStefano Zampini   /* Setup of Graph */
2963785d1243SStefano Zampini   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) { /* need to convert from global to local */
2964a7dc3881SStefano Zampini     ierr = PCBDDCGlobalToLocal(matis->ctx,pcis->vec1_global,pcis->vec1_N,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
2965785d1243SStefano Zampini   }
2966785d1243SStefano Zampini   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) { /* need to convert from global to local */
2967a7dc3881SStefano Zampini     ierr = PCBDDCGlobalToLocal(matis->ctx,pcis->vec1_global,pcis->vec1_N,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
2968785d1243SStefano Zampini   }
2969302440fdSBarry Smith   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices);CHKERRQ(ierr);
2970674ae819SStefano Zampini 
2971674ae819SStefano Zampini   /* Graph's connected components analysis */
2972674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
2973674ae819SStefano Zampini 
2974674ae819SStefano Zampini   /* print some info to stdout */
2975674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
2976302440fdSBarry Smith     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);CHKERRQ(ierr);
2977674ae819SStefano Zampini   }
2978fb180af4SStefano Zampini 
2979fb180af4SStefano Zampini   /* mark topography has done */
2980fb180af4SStefano Zampini   pcbddc->recompute_topography = PETSC_FALSE;
2981674ae819SStefano Zampini   PetscFunctionReturn(0);
2982674ae819SStefano Zampini }
2983674ae819SStefano Zampini 
2984674ae819SStefano Zampini #undef __FUNCT__
2985674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
2986674ae819SStefano 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[])
2987674ae819SStefano Zampini {
2988674ae819SStefano Zampini   Vec            local_vec,global_vec;
2989674ae819SStefano Zampini   IS             seqis,paris;
2990674ae819SStefano Zampini   VecScatter     scatter_ctx;
2991674ae819SStefano Zampini   PetscScalar    *array;
2992674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
2993674ae819SStefano Zampini   PetscScalar    globalsum;
2994674ae819SStefano Zampini   PetscInt       i,j,s;
299517ccb9bdSStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local,max_global;
299617ccb9bdSStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm;
299717ccb9bdSStefano Zampini   PetscInt       *dof_sizes,*dof_displs;
2998674ae819SStefano Zampini   PetscBool      first_found;
2999674ae819SStefano Zampini   PetscErrorCode ierr;
3000674ae819SStefano Zampini 
3001674ae819SStefano Zampini   PetscFunctionBegin;
3002674ae819SStefano Zampini   /* mpi buffers */
3003b9b85e73SStefano Zampini   ierr = MPI_Comm_size(comm,&size_prec_comm);CHKERRQ(ierr);
3004b9b85e73SStefano Zampini   ierr = MPI_Comm_rank(comm,&rank_prec_comm);CHKERRQ(ierr);
3005674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
300617ccb9bdSStefano Zampini   ierr = PetscMalloc2(j,&dof_sizes,j,&dof_displs);CHKERRQ(ierr);
3007674ae819SStefano Zampini   /* get maximum size of subset */
3008785e854fSJed Brown   ierr = PetscMalloc1(n_local_dofs,&temp_global_dofs);CHKERRQ(ierr);
3009674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
3010674ae819SStefano Zampini   max_local = 0;
3011b9b85e73SStefano Zampini   for (i=0;i<n_local_dofs;i++) {
3012674ae819SStefano Zampini     if (max_local < temp_global_dofs[i] ) {
3013674ae819SStefano Zampini       max_local = temp_global_dofs[i];
3014674ae819SStefano Zampini     }
3015674ae819SStefano Zampini   }
3016b9b85e73SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);CHKERRQ(ierr);
3017674ae819SStefano Zampini   max_global++;
3018674ae819SStefano Zampini   max_local = 0;
3019b9b85e73SStefano Zampini   for (i=0;i<n_local_dofs;i++) {
3020674ae819SStefano Zampini     if (max_local < local_dofs[i] ) {
3021674ae819SStefano Zampini       max_local = local_dofs[i];
3022674ae819SStefano Zampini     }
3023674ae819SStefano Zampini   }
3024674ae819SStefano Zampini   max_local++;
3025674ae819SStefano Zampini   /* allocate workspace */
3026674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
3027674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
3028674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
3029674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
3030674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
3031674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
3032674ae819SStefano Zampini   /* create scatter */
3033674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
3034674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
3035674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
3036674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
3037674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
3038674ae819SStefano Zampini   /* init array */
3039674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
3040674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
3041674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
3042674ae819SStefano Zampini   if (local_dofs_mult) {
3043674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
3044674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
3045674ae819SStefano Zampini     }
3046674ae819SStefano Zampini   } else {
3047674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
3048674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
3049674ae819SStefano Zampini     }
3050674ae819SStefano Zampini   }
3051674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
3052674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
3053674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3054674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3055674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
30565b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
3057674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
3058674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
3059674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
3060674ae819SStefano Zampini   nlocals = 0;
3061674ae819SStefano Zampini   first_index = -1;
3062674ae819SStefano Zampini   first_found = PETSC_FALSE;
3063674ae819SStefano Zampini   for (i=0;i<s;i++) {
3064b9b85e73SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.1) {
3065674ae819SStefano Zampini       first_found = PETSC_TRUE;
3066674ae819SStefano Zampini       first_index = i;
3067674ae819SStefano Zampini     }
30685b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
3069674ae819SStefano Zampini   }
3070674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
3071674ae819SStefano Zampini   if (!rank_prec_comm) {
3072674ae819SStefano Zampini     dof_displs[0]=0;
3073674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
3074674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
3075674ae819SStefano Zampini     }
3076674ae819SStefano Zampini   }
3077674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
3078674ae819SStefano Zampini   if (first_found) {
3079674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
3080674ae819SStefano Zampini     old_index = first_index;
3081674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
3082b9b85e73SStefano Zampini       if (PetscRealPart(array[i]) > 0.1) {
3083674ae819SStefano Zampini         array[i] += array[old_index];
3084674ae819SStefano Zampini         old_index = i;
3085674ae819SStefano Zampini       }
3086674ae819SStefano Zampini     }
3087674ae819SStefano Zampini   }
3088674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
3089674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
3090674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3091674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3092674ae819SStefano Zampini   /* get global ordering of local dofs */
30932b095fd8SStefano Zampini   ierr = VecGetArrayRead(local_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
3094674ae819SStefano Zampini   if (local_dofs_mult) {
3095674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
30965b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
3097674ae819SStefano Zampini     }
3098674ae819SStefano Zampini   } else {
3099674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
31005b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
3101674ae819SStefano Zampini     }
3102674ae819SStefano Zampini   }
31032b095fd8SStefano Zampini   ierr = VecRestoreArrayRead(local_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
3104674ae819SStefano Zampini   /* free workspace */
3105674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
3106674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
3107674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
310817ccb9bdSStefano Zampini   ierr = PetscFree2(dof_sizes,dof_displs);CHKERRQ(ierr);
3109674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
3110674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
3111674ae819SStefano Zampini   PetscFunctionReturn(0);
3112674ae819SStefano Zampini }
31139a7d3425SStefano Zampini 
31149a7d3425SStefano Zampini #undef __FUNCT__
31159a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
31169a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
31179a7d3425SStefano Zampini {
31189a7d3425SStefano Zampini   PetscInt       i,j;
31199a7d3425SStefano Zampini   PetscScalar    *alphas;
31209a7d3425SStefano Zampini   PetscErrorCode ierr;
31219a7d3425SStefano Zampini 
31229a7d3425SStefano Zampini   PetscFunctionBegin;
31239a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
3124785e854fSJed Brown   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
31259a7d3425SStefano Zampini   for (i=0;i<n;i++) {
31269a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
31279a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
31289a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
31299a7d3425SStefano Zampini   }
31309a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
31319a7d3425SStefano Zampini   PetscFunctionReturn(0);
31329a7d3425SStefano Zampini }
31339a7d3425SStefano Zampini 
3134e7931f94SStefano Zampini #undef __FUNCT__
313570cf5478SStefano Zampini #define __FUNCT__ "MatISGetSubassemblingPattern"
313628143c3dSStefano Zampini PetscErrorCode MatISGetSubassemblingPattern(Mat mat, PetscInt n_subdomains, PetscBool contiguous, IS* is_sends)
3137e7931f94SStefano Zampini {
3138e7931f94SStefano Zampini   Mat             subdomain_adj;
3139e7931f94SStefano Zampini   IS              new_ranks,ranks_send_to;
3140e7931f94SStefano Zampini   MatPartitioning partitioner;
3141e7931f94SStefano Zampini   Mat_IS          *matis;
3142e7931f94SStefano Zampini   PetscInt        n_neighs,*neighs,*n_shared,**shared;
3143e7931f94SStefano Zampini   PetscInt        prank;
3144e7931f94SStefano Zampini   PetscMPIInt     size,rank,color;
3145e7931f94SStefano Zampini   PetscInt        *xadj,*adjncy,*oldranks;
3146e7931f94SStefano Zampini   PetscInt        *adjncy_wgt,*v_wgt,*is_indices,*ranks_send_to_idx;
31473837a79fSStefano Zampini   PetscInt        i,local_size,threshold=0;
3148e7931f94SStefano Zampini   PetscErrorCode  ierr;
31492b510759SStefano Zampini   PetscBool       use_vwgt=PETSC_FALSE,use_square=PETSC_FALSE;
3150e7931f94SStefano Zampini   PetscSubcomm    subcomm;
3151a57a6d2fSStefano Zampini 
3152e7931f94SStefano Zampini   PetscFunctionBegin;
31532b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_square",&use_square,NULL);CHKERRQ(ierr);
31542b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
31552b510759SStefano Zampini   ierr = PetscOptionsGetInt(NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
3156e7931f94SStefano Zampini 
3157e7931f94SStefano Zampini   /* Get info on mapping */
3158e7931f94SStefano Zampini   matis = (Mat_IS*)(mat->data);
3159e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&local_size);CHKERRQ(ierr);
3160e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
3161e7931f94SStefano Zampini 
3162e7931f94SStefano Zampini   /* build local CSR graph of subdomains' connectivity */
3163785e854fSJed Brown   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
3164e7931f94SStefano Zampini   xadj[0] = 0;
3165e7931f94SStefano Zampini   xadj[1] = PetscMax(n_neighs-1,0);
3166785e854fSJed Brown   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
3167785e854fSJed Brown   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
3168e7931f94SStefano Zampini 
31692b510759SStefano Zampini   if (threshold) {
3170d023bfaeSStefano Zampini     PetscInt xadj_count = 0;
31712b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
3172d023bfaeSStefano Zampini       if (n_shared[i] > threshold) {
3173d023bfaeSStefano Zampini         adjncy[xadj_count] = neighs[i];
3174d023bfaeSStefano Zampini         adjncy_wgt[xadj_count] = n_shared[i];
3175d023bfaeSStefano Zampini         xadj_count++;
3176e7931f94SStefano Zampini       }
3177e7931f94SStefano Zampini     }
3178d023bfaeSStefano Zampini     xadj[1] = xadj_count;
3179c8587f34SStefano Zampini   } else {
3180e7931f94SStefano Zampini     if (xadj[1]) {
3181e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy,&neighs[1],xadj[1]*sizeof(*adjncy));CHKERRQ(ierr);
3182e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy_wgt,&n_shared[1],xadj[1]*sizeof(*adjncy_wgt));CHKERRQ(ierr);
3183c8587f34SStefano Zampini     }
3184e7931f94SStefano Zampini   }
3185e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingRestoreInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
3186e7931f94SStefano Zampini   if (use_square) {
3187e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
3188e7931f94SStefano Zampini       adjncy_wgt[i] = adjncy_wgt[i]*adjncy_wgt[i];
3189e7931f94SStefano Zampini     }
3190e7931f94SStefano Zampini   }
3191e7931f94SStefano Zampini   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
3192e7931f94SStefano Zampini 
31933837a79fSStefano Zampini   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
3194e7931f94SStefano Zampini 
3195e7931f94SStefano Zampini   /*
3196e7931f94SStefano Zampini     Restrict work on active processes only.
3197e7931f94SStefano Zampini   */
3198e7931f94SStefano Zampini   ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&subcomm);CHKERRQ(ierr);
3199e7931f94SStefano Zampini   ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
3200e7931f94SStefano Zampini   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
32012b510759SStefano Zampini   ierr = PetscMPIIntCast(!local_size,&color);CHKERRQ(ierr);
3202d3531aaaSJed Brown   ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
3203e7931f94SStefano Zampini   if (color) {
3204e7931f94SStefano Zampini     ierr = PetscFree(xadj);CHKERRQ(ierr);
3205e7931f94SStefano Zampini     ierr = PetscFree(adjncy);CHKERRQ(ierr);
3206e7931f94SStefano Zampini     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
3207c8587f34SStefano Zampini   } else {
320828143c3dSStefano Zampini     PetscInt coarsening_ratio;
3209306c2d5bSBarry Smith     ierr = MPI_Comm_size(PetscSubcommChild(subcomm),&size);CHKERRQ(ierr);
3210785e854fSJed Brown     ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
3211e7931f94SStefano Zampini     prank = rank;
3212306c2d5bSBarry Smith     ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,PetscSubcommChild(subcomm));CHKERRQ(ierr);
32138002ef2cSStefano Zampini     /*
3214e7931f94SStefano Zampini     for (i=0;i<size;i++) {
3215e7931f94SStefano Zampini       PetscPrintf(subcomm->comm,"oldranks[%d] = %d\n",i,oldranks[i]);
3216c8587f34SStefano Zampini     }
32178002ef2cSStefano Zampini     */
3218e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
3219e7931f94SStefano Zampini       ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
3220c8587f34SStefano Zampini     }
3221e7931f94SStefano Zampini     ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
3222306c2d5bSBarry Smith     ierr = MatCreateMPIAdj(PetscSubcommChild(subcomm),1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
322322b6e8a2SStefano Zampini     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
3224e7931f94SStefano Zampini 
3225e7931f94SStefano Zampini     /* Partition */
3226306c2d5bSBarry Smith     ierr = MatPartitioningCreate(PetscSubcommChild(subcomm),&partitioner);CHKERRQ(ierr);
3227e7931f94SStefano Zampini     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
3228e7931f94SStefano Zampini     if (use_vwgt) {
32293837a79fSStefano Zampini       ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
3230e7931f94SStefano Zampini       v_wgt[0] = local_size;
3231e7931f94SStefano Zampini       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
3232c8587f34SStefano Zampini     }
323328143c3dSStefano Zampini     n_subdomains = PetscMin((PetscInt)size,n_subdomains);
323428143c3dSStefano Zampini     coarsening_ratio = size/n_subdomains;
323528143c3dSStefano Zampini     ierr = MatPartitioningSetNParts(partitioner,n_subdomains);CHKERRQ(ierr);
3236e7931f94SStefano Zampini     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
3237e7931f94SStefano Zampini     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
323822b6e8a2SStefano Zampini     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
3239e7931f94SStefano Zampini 
3240e7931f94SStefano Zampini     ierr = ISGetIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
324128143c3dSStefano Zampini     if (contiguous) {
324228143c3dSStefano Zampini       ranks_send_to_idx[0] = oldranks[is_indices[0]]; /* contiguos set of processes */
324328143c3dSStefano Zampini     } else {
324484ba6060SStefano Zampini       ranks_send_to_idx[0] = coarsening_ratio*oldranks[is_indices[0]]; /* scattered set of processes */
324528143c3dSStefano Zampini     }
3246e7931f94SStefano Zampini     ierr = ISRestoreIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
3247e7931f94SStefano Zampini     /* clean up */
3248e7931f94SStefano Zampini     ierr = PetscFree(oldranks);CHKERRQ(ierr);
3249e7931f94SStefano Zampini     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
3250e7931f94SStefano Zampini     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
3251e7931f94SStefano Zampini     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
3252e7931f94SStefano Zampini   }
3253e7931f94SStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
3254e7931f94SStefano Zampini 
3255e7931f94SStefano Zampini   /* assemble parallel IS for sends */
3256e7931f94SStefano Zampini   i = 1;
3257e7931f94SStefano Zampini   if (color) i=0;
3258e7931f94SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,&ranks_send_to);CHKERRQ(ierr);
3259e7931f94SStefano Zampini 
3260e7931f94SStefano Zampini   /* get back IS */
3261e7931f94SStefano Zampini   *is_sends = ranks_send_to;
3262e7931f94SStefano Zampini   PetscFunctionReturn(0);
3263e7931f94SStefano Zampini }
3264e7931f94SStefano Zampini 
3265e7931f94SStefano Zampini typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
3266e7931f94SStefano Zampini 
3267e7931f94SStefano Zampini #undef __FUNCT__
3268e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble"
326928143c3dSStefano Zampini PetscErrorCode MatISSubassemble(Mat mat, IS is_sends, PetscInt n_subdomains, PetscBool restrict_comm, MatReuse reuse, Mat *mat_n, PetscInt nis, IS isarray[])
3270e7931f94SStefano Zampini {
327170cf5478SStefano Zampini   Mat                    local_mat;
3272e7931f94SStefano Zampini   Mat_IS                 *matis;
3273e7931f94SStefano Zampini   IS                     is_sends_internal;
32749d30be91SStefano Zampini   PetscInt               rows,cols,new_local_rows;
327528143c3dSStefano Zampini   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals;
32769d30be91SStefano Zampini   PetscBool              ismatis,isdense,newisdense,destroy_mat;
3277e7931f94SStefano Zampini   ISLocalToGlobalMapping l2gmap;
3278e7931f94SStefano Zampini   PetscInt*              l2gmap_indices;
3279e7931f94SStefano Zampini   const PetscInt*        is_indices;
3280e7931f94SStefano Zampini   MatType                new_local_type;
3281e7931f94SStefano Zampini   /* buffers */
3282e7931f94SStefano Zampini   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
328328143c3dSStefano Zampini   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
32849d30be91SStefano Zampini   PetscInt               *recv_buffer_idxs_local;
3285e7931f94SStefano Zampini   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
3286e7931f94SStefano Zampini   /* MPI */
328728143c3dSStefano Zampini   MPI_Comm               comm,comm_n;
328828143c3dSStefano Zampini   PetscSubcomm           subcomm;
3289e7931f94SStefano Zampini   PetscMPIInt            n_sends,n_recvs,commsize;
329028143c3dSStefano Zampini   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
329128143c3dSStefano Zampini   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
329228143c3dSStefano Zampini   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,source_dest;
329328143c3dSStefano Zampini   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals;
329428143c3dSStefano Zampini   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals;
3295e7931f94SStefano Zampini   PetscErrorCode         ierr;
3296e7931f94SStefano Zampini 
3297e7931f94SStefano Zampini   PetscFunctionBegin;
329828143c3dSStefano Zampini   /* TODO: add missing checks */
329928143c3dSStefano Zampini   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
330028143c3dSStefano Zampini   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
330128143c3dSStefano Zampini   PetscValidLogicalCollectiveEnum(mat,reuse,5);
330228143c3dSStefano Zampini   PetscValidLogicalCollectiveInt(mat,nis,7);
3303e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
330428143c3dSStefano Zampini   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",__FUNCT__);
3305e7931f94SStefano Zampini   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
3306e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
3307e7931f94SStefano Zampini   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
3308e7931f94SStefano Zampini   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
3309e7931f94SStefano Zampini   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
331028143c3dSStefano Zampini   if (reuse == MAT_REUSE_MATRIX && *mat_n) {
331170cf5478SStefano Zampini     PetscInt mrows,mcols,mnrows,mncols;
331270cf5478SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
331328143c3dSStefano Zampini     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
331470cf5478SStefano Zampini     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
331570cf5478SStefano Zampini     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
331670cf5478SStefano Zampini     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
331770cf5478SStefano Zampini     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
331870cf5478SStefano Zampini   }
3319e7931f94SStefano Zampini   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
3320e7931f94SStefano Zampini   PetscValidLogicalCollectiveInt(mat,bs,0);
3321e7931f94SStefano Zampini   /* prepare IS for sending if not provided */
3322e7931f94SStefano Zampini   if (!is_sends) {
332328143c3dSStefano Zampini     PetscBool pcontig = PETSC_TRUE;
332428143c3dSStefano Zampini     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
332528143c3dSStefano Zampini     ierr = MatISGetSubassemblingPattern(mat,n_subdomains,pcontig,&is_sends_internal);CHKERRQ(ierr);
3326c8587f34SStefano Zampini   } else {
3327e7931f94SStefano Zampini     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
3328e7931f94SStefano Zampini     is_sends_internal = is_sends;
3329c8587f34SStefano Zampini   }
3330e7931f94SStefano Zampini 
3331e7931f94SStefano Zampini   /* get pointer of MATIS data */
3332e7931f94SStefano Zampini   matis = (Mat_IS*)mat->data;
3333e7931f94SStefano Zampini 
3334e7931f94SStefano Zampini   /* get comm */
3335a316fed8SStefano Zampini   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
3336e7931f94SStefano Zampini 
3337e7931f94SStefano Zampini   /* compute number of sends */
3338e7931f94SStefano Zampini   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
3339e7931f94SStefano Zampini   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
3340e7931f94SStefano Zampini 
3341e7931f94SStefano Zampini   /* compute number of receives */
3342e7931f94SStefano Zampini   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
3343785e854fSJed Brown   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
3344e7931f94SStefano Zampini   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
3345e7931f94SStefano Zampini   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
3346e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
3347e7931f94SStefano Zampini   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
3348e7931f94SStefano Zampini   ierr = PetscFree(iflags);CHKERRQ(ierr);
3349e7931f94SStefano Zampini 
335028143c3dSStefano Zampini   /* restrict comm if requested */
335128143c3dSStefano Zampini   subcomm = 0;
335228143c3dSStefano Zampini   destroy_mat = PETSC_FALSE;
335328143c3dSStefano Zampini   if (restrict_comm) {
3354779c1cceSStefano Zampini     PetscMPIInt color,subcommsize;
3355779c1cceSStefano Zampini 
335628143c3dSStefano Zampini     color = 0;
3357779c1cceSStefano Zampini     if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm */
335828143c3dSStefano Zampini     ierr = MPI_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
335928143c3dSStefano Zampini     subcommsize = commsize - subcommsize;
336028143c3dSStefano Zampini     /* check if reuse has been requested */
336128143c3dSStefano Zampini     if (reuse == MAT_REUSE_MATRIX) {
336228143c3dSStefano Zampini       if (*mat_n) {
336328143c3dSStefano Zampini         PetscMPIInt subcommsize2;
336428143c3dSStefano Zampini         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
336528143c3dSStefano Zampini         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
336628143c3dSStefano Zampini         comm_n = PetscObjectComm((PetscObject)*mat_n);
336728143c3dSStefano Zampini       } else {
336828143c3dSStefano Zampini         comm_n = PETSC_COMM_SELF;
336928143c3dSStefano Zampini       }
337028143c3dSStefano Zampini     } else { /* MAT_INITIAL_MATRIX */
3371779c1cceSStefano Zampini       PetscMPIInt rank;
3372779c1cceSStefano Zampini 
3373779c1cceSStefano Zampini       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
337428143c3dSStefano Zampini       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
337528143c3dSStefano Zampini       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
337628143c3dSStefano Zampini       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
3377306c2d5bSBarry Smith       comm_n = PetscSubcommChild(subcomm);
337828143c3dSStefano Zampini     }
337928143c3dSStefano Zampini     /* flag to destroy *mat_n if not significative */
338028143c3dSStefano Zampini     if (color) destroy_mat = PETSC_TRUE;
338128143c3dSStefano Zampini   } else {
338228143c3dSStefano Zampini     comm_n = comm;
338328143c3dSStefano Zampini   }
338428143c3dSStefano Zampini 
3385e7931f94SStefano Zampini   /* prepare send/receive buffers */
3386785e854fSJed Brown   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
3387e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
3388785e854fSJed Brown   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
3389e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
339028143c3dSStefano Zampini   if (nis) {
3391854ce69bSBarry Smith     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
339228143c3dSStefano Zampini   }
3393e7931f94SStefano Zampini 
339428143c3dSStefano Zampini   /* Get data from local matrices */
3395e7931f94SStefano Zampini   if (!isdense) {
3396a26c9d0eSStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
3397e7931f94SStefano Zampini     /* TODO: See below some guidelines on how to prepare the local buffers */
3398e7931f94SStefano Zampini     /*
3399e7931f94SStefano Zampini        send_buffer_vals should contain the raw values of the local matrix
3400e7931f94SStefano Zampini        send_buffer_idxs should contain:
3401e7931f94SStefano Zampini        - MatType_PRIVATE type
3402e7931f94SStefano Zampini        - PetscInt        size_of_l2gmap
3403e7931f94SStefano Zampini        - PetscInt        global_row_indices[size_of_l2gmap]
3404e7931f94SStefano Zampini        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
3405e7931f94SStefano Zampini     */
3406e7931f94SStefano Zampini   } else {
3407e7931f94SStefano Zampini     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
3408e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&i);CHKERRQ(ierr);
3409854ce69bSBarry Smith     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
3410e7931f94SStefano Zampini     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
3411e7931f94SStefano Zampini     send_buffer_idxs[1] = i;
3412e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
3413e7931f94SStefano Zampini     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
3414e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingRestoreIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
3415e7931f94SStefano Zampini     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
3416e7931f94SStefano Zampini     for (i=0;i<n_sends;i++) {
3417e7931f94SStefano Zampini       ilengths_vals[is_indices[i]] = len*len;
3418e7931f94SStefano Zampini       ilengths_idxs[is_indices[i]] = len+2;
3419c8587f34SStefano Zampini     }
3420c8587f34SStefano Zampini   }
3421e7931f94SStefano Zampini   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
342228143c3dSStefano Zampini   /* additional is (if any) */
342328143c3dSStefano Zampini   if (nis) {
342428143c3dSStefano Zampini     PetscMPIInt psum;
342528143c3dSStefano Zampini     PetscInt j;
342628143c3dSStefano Zampini     for (j=0,psum=0;j<nis;j++) {
342728143c3dSStefano Zampini       PetscInt plen;
342828143c3dSStefano Zampini       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
342928143c3dSStefano Zampini       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
343028143c3dSStefano Zampini       psum += len+1; /* indices + lenght */
343128143c3dSStefano Zampini     }
3432854ce69bSBarry Smith     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
343328143c3dSStefano Zampini     for (j=0,psum=0;j<nis;j++) {
343428143c3dSStefano Zampini       PetscInt plen;
343528143c3dSStefano Zampini       const PetscInt *is_array_idxs;
343628143c3dSStefano Zampini       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
343728143c3dSStefano Zampini       send_buffer_idxs_is[psum] = plen;
343828143c3dSStefano Zampini       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
343928143c3dSStefano Zampini       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
344028143c3dSStefano Zampini       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
344128143c3dSStefano Zampini       psum += plen+1; /* indices + lenght */
344228143c3dSStefano Zampini     }
344328143c3dSStefano Zampini     for (i=0;i<n_sends;i++) {
344428143c3dSStefano Zampini       ilengths_idxs_is[is_indices[i]] = psum;
344528143c3dSStefano Zampini     }
344628143c3dSStefano Zampini     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
344728143c3dSStefano Zampini   }
344828143c3dSStefano Zampini 
3449e7931f94SStefano Zampini   buf_size_idxs = 0;
3450e7931f94SStefano Zampini   buf_size_vals = 0;
345128143c3dSStefano Zampini   buf_size_idxs_is = 0;
3452e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3453e7931f94SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
3454e7931f94SStefano Zampini     buf_size_vals += (PetscInt)olengths_vals[i];
345528143c3dSStefano Zampini     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
3456e7931f94SStefano Zampini   }
3457785e854fSJed Brown   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
3458785e854fSJed Brown   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
345995ecbf38SStefano Zampini   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
3460e7931f94SStefano Zampini 
3461e7931f94SStefano Zampini   /* get new tags for clean communications */
3462e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
3463e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
346428143c3dSStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
3465e7931f94SStefano Zampini 
3466e7931f94SStefano Zampini   /* allocate for requests */
3467785e854fSJed Brown   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
3468785e854fSJed Brown   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
346995ecbf38SStefano Zampini   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
3470785e854fSJed Brown   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
3471785e854fSJed Brown   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
347295ecbf38SStefano Zampini   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
3473e7931f94SStefano Zampini 
3474e7931f94SStefano Zampini   /* communications */
3475e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
3476e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
347728143c3dSStefano Zampini   ptr_idxs_is = recv_buffer_idxs_is;
3478e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3479e7931f94SStefano Zampini     source_dest = onodes[i];
3480e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
3481e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
3482e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3483e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
348428143c3dSStefano Zampini     if (nis) {
348528143c3dSStefano 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);
348628143c3dSStefano Zampini       ptr_idxs_is += olengths_idxs_is[i];
348728143c3dSStefano Zampini     }
3488e7931f94SStefano Zampini   }
3489e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) {
3490e7931f94SStefano Zampini     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
3491e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
3492e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
349328143c3dSStefano Zampini     if (nis) {
349428143c3dSStefano 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);
349528143c3dSStefano Zampini     }
3496e7931f94SStefano Zampini   }
3497e7931f94SStefano Zampini   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
3498e7931f94SStefano Zampini   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
3499e7931f94SStefano Zampini 
3500e7931f94SStefano Zampini   /* assemble new l2g map */
3501e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3502e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
35039d30be91SStefano Zampini   new_local_rows = 0;
3504e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
35059d30be91SStefano Zampini     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
3506e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3507e7931f94SStefano Zampini   }
35089d30be91SStefano Zampini   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
3509e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
35109d30be91SStefano Zampini   new_local_rows = 0;
3511e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
35129d30be91SStefano Zampini     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
35139d30be91SStefano Zampini     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
3514e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3515e7931f94SStefano Zampini   }
35169d30be91SStefano Zampini   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
35179d30be91SStefano Zampini   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
3518e7931f94SStefano Zampini   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
3519e7931f94SStefano Zampini 
3520e7931f94SStefano Zampini   /* infer new local matrix type from received local matrices type */
3521e7931f94SStefano Zampini   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
3522e7931f94SStefano 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) */
3523e7931f94SStefano Zampini   if (n_recvs) {
352428143c3dSStefano Zampini     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
3525e7931f94SStefano Zampini     ptr_idxs = recv_buffer_idxs;
3526e7931f94SStefano Zampini     for (i=0;i<n_recvs;i++) {
3527e7931f94SStefano Zampini       if ((PetscInt)new_local_type_private != *ptr_idxs) {
3528e7931f94SStefano Zampini         new_local_type_private = MATAIJ_PRIVATE;
3529e7931f94SStefano Zampini         break;
3530e7931f94SStefano Zampini       }
3531e7931f94SStefano Zampini       ptr_idxs += olengths_idxs[i];
3532e7931f94SStefano Zampini     }
3533e7931f94SStefano Zampini     switch (new_local_type_private) {
353428143c3dSStefano Zampini       case MATDENSE_PRIVATE:
353528143c3dSStefano Zampini         if (n_recvs>1) { /* subassembling of dense matrices does not give a dense matrix! */
3536e7931f94SStefano Zampini           new_local_type = MATSEQAIJ;
3537e7931f94SStefano Zampini           bs = 1;
353828143c3dSStefano Zampini         } else { /* if I receive only 1 dense matrix */
353928143c3dSStefano Zampini           new_local_type = MATSEQDENSE;
354028143c3dSStefano Zampini           bs = 1;
354128143c3dSStefano Zampini         }
3542e7931f94SStefano Zampini         break;
3543e7931f94SStefano Zampini       case MATAIJ_PRIVATE:
3544e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
3545e7931f94SStefano Zampini         bs = 1;
3546e7931f94SStefano Zampini         break;
3547e7931f94SStefano Zampini       case MATBAIJ_PRIVATE:
3548e7931f94SStefano Zampini         new_local_type = MATSEQBAIJ;
3549e7931f94SStefano Zampini         break;
3550e7931f94SStefano Zampini       case MATSBAIJ_PRIVATE:
3551e7931f94SStefano Zampini         new_local_type = MATSEQSBAIJ;
3552e7931f94SStefano Zampini         break;
3553e7931f94SStefano Zampini       default:
35549d30be91SStefano Zampini         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,__FUNCT__);
3555e7931f94SStefano Zampini         break;
3556e7931f94SStefano Zampini     }
355728143c3dSStefano Zampini   } else { /* by default, new_local_type is seqdense */
355828143c3dSStefano Zampini     new_local_type = MATSEQDENSE;
355928143c3dSStefano Zampini     bs = 1;
3560e7931f94SStefano Zampini   }
3561e7931f94SStefano Zampini 
356270cf5478SStefano Zampini   /* create MATIS object if needed */
356370cf5478SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
3564e7931f94SStefano Zampini     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
356528143c3dSStefano Zampini     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,mat_n);CHKERRQ(ierr);
356670cf5478SStefano Zampini   } else {
356770cf5478SStefano Zampini     /* it also destroys the local matrices */
356870cf5478SStefano Zampini     ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
356970cf5478SStefano Zampini   }
357070cf5478SStefano Zampini   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
3571e7931f94SStefano Zampini   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
35729d30be91SStefano Zampini 
35739d30be91SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
35749d30be91SStefano Zampini 
35759d30be91SStefano Zampini   /* Global to local map of received indices */
35769d30be91SStefano Zampini   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
35779d30be91SStefano Zampini   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
35789d30be91SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
35799d30be91SStefano Zampini 
35809d30be91SStefano Zampini   /* restore attributes -> type of incoming data and its size */
35819d30be91SStefano Zampini   buf_size_idxs = 0;
35829d30be91SStefano Zampini   for (i=0;i<n_recvs;i++) {
35839d30be91SStefano Zampini     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
35849d30be91SStefano Zampini     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
35859d30be91SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
35869d30be91SStefano Zampini   }
35879d30be91SStefano Zampini   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
35889d30be91SStefano Zampini 
35899d30be91SStefano Zampini   /* set preallocation */
35909d30be91SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
35919d30be91SStefano Zampini   if (!newisdense) {
35929d30be91SStefano Zampini     PetscInt *new_local_nnz=0;
35939d30be91SStefano Zampini 
35949d30be91SStefano Zampini     ptr_vals = recv_buffer_vals;
35959d30be91SStefano Zampini     ptr_idxs = recv_buffer_idxs_local;
35969d30be91SStefano Zampini     if (n_recvs) {
35979d30be91SStefano Zampini       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
35989d30be91SStefano Zampini     }
35999d30be91SStefano Zampini     for (i=0;i<n_recvs;i++) {
36009d30be91SStefano Zampini       PetscInt j;
36019d30be91SStefano Zampini       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
36029d30be91SStefano Zampini         for (j=0;j<*(ptr_idxs+1);j++) {
36039d30be91SStefano Zampini           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
36049d30be91SStefano Zampini         }
36059d30be91SStefano Zampini       } else {
36069d30be91SStefano Zampini         /* TODO */
36079d30be91SStefano Zampini       }
36089d30be91SStefano Zampini       ptr_idxs += olengths_idxs[i];
36099d30be91SStefano Zampini     }
36109d30be91SStefano Zampini     if (new_local_nnz) {
36119d30be91SStefano Zampini       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
36129d30be91SStefano Zampini       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
36139d30be91SStefano Zampini       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
36149d30be91SStefano Zampini       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
36159d30be91SStefano Zampini       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
36169d30be91SStefano Zampini       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
36179d30be91SStefano Zampini     } else {
36189d30be91SStefano Zampini       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
36199d30be91SStefano Zampini     }
36209d30be91SStefano Zampini     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
36219d30be91SStefano Zampini   } else {
36229d30be91SStefano Zampini     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
36239d30be91SStefano Zampini   }
3624e7931f94SStefano Zampini 
3625e7931f94SStefano Zampini   /* set values */
3626e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
36279d30be91SStefano Zampini   ptr_idxs = recv_buffer_idxs_local;
3628e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3629e7931f94SStefano Zampini     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
3630e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
36319d30be91SStefano Zampini       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
3632e7931f94SStefano Zampini       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3633e7931f94SStefano Zampini       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3634e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
363528143c3dSStefano Zampini     } else {
363628143c3dSStefano Zampini       /* TODO */
3637e7931f94SStefano Zampini     }
3638e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3639e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
3640e7931f94SStefano Zampini   }
3641e7931f94SStefano Zampini   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3642e7931f94SStefano Zampini   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
364370cf5478SStefano Zampini   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
364470cf5478SStefano Zampini   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
36459d30be91SStefano Zampini   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
36469d30be91SStefano Zampini   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
3647e7931f94SStefano Zampini 
3648dfd14d43SStefano Zampini #if 0
364928143c3dSStefano Zampini   if (!restrict_comm) { /* check */
3650e7931f94SStefano Zampini     Vec       lvec,rvec;
3651e7931f94SStefano Zampini     PetscReal infty_error;
3652e7931f94SStefano Zampini 
36532a7a6963SBarry Smith     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
3654e7931f94SStefano Zampini     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
3655e7931f94SStefano Zampini     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
3656e7931f94SStefano Zampini     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
365770cf5478SStefano Zampini     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
3658e7931f94SStefano Zampini     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3659e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
3660e7931f94SStefano Zampini     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
3661e7931f94SStefano Zampini     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
3662e7931f94SStefano Zampini   }
366328143c3dSStefano Zampini #endif
3664e7931f94SStefano Zampini 
366528143c3dSStefano Zampini   /* assemble new additional is (if any) */
366628143c3dSStefano Zampini   if (nis) {
366728143c3dSStefano Zampini     PetscInt **temp_idxs,*count_is,j,psum;
366828143c3dSStefano Zampini 
366928143c3dSStefano Zampini     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3670854ce69bSBarry Smith     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
367128143c3dSStefano Zampini     ptr_idxs = recv_buffer_idxs_is;
367228143c3dSStefano Zampini     psum = 0;
367328143c3dSStefano Zampini     for (i=0;i<n_recvs;i++) {
367428143c3dSStefano Zampini       for (j=0;j<nis;j++) {
367528143c3dSStefano Zampini         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
367628143c3dSStefano Zampini         count_is[j] += plen; /* increment counting of buffer for j-th IS */
367728143c3dSStefano Zampini         psum += plen;
367828143c3dSStefano Zampini         ptr_idxs += plen+1; /* shift pointer to received data */
367928143c3dSStefano Zampini       }
368028143c3dSStefano Zampini     }
3681854ce69bSBarry Smith     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
3682854ce69bSBarry Smith     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
368328143c3dSStefano Zampini     for (i=1;i<nis;i++) {
368428143c3dSStefano Zampini       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
368528143c3dSStefano Zampini     }
368628143c3dSStefano Zampini     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
368728143c3dSStefano Zampini     ptr_idxs = recv_buffer_idxs_is;
368828143c3dSStefano Zampini     for (i=0;i<n_recvs;i++) {
368928143c3dSStefano Zampini       for (j=0;j<nis;j++) {
369028143c3dSStefano Zampini         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
369128143c3dSStefano Zampini         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
369228143c3dSStefano Zampini         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
369328143c3dSStefano Zampini         ptr_idxs += plen+1; /* shift pointer to received data */
369428143c3dSStefano Zampini       }
369528143c3dSStefano Zampini     }
369628143c3dSStefano Zampini     for (i=0;i<nis;i++) {
369728143c3dSStefano Zampini       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
369828143c3dSStefano Zampini       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
369928143c3dSStefano Zampini       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
370028143c3dSStefano Zampini     }
370128143c3dSStefano Zampini     ierr = PetscFree(count_is);CHKERRQ(ierr);
370228143c3dSStefano Zampini     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
370328143c3dSStefano Zampini     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
370428143c3dSStefano Zampini   }
3705e7931f94SStefano Zampini   /* free workspace */
370628143c3dSStefano Zampini   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
3707e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3708e7931f94SStefano Zampini   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
3709e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3710e7931f94SStefano Zampini   if (isdense) {
3711e7931f94SStefano Zampini     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
3712e7931f94SStefano Zampini     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
3713e7931f94SStefano Zampini   } else {
3714e7931f94SStefano Zampini     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
3715e7931f94SStefano Zampini   }
371628143c3dSStefano Zampini   if (nis) {
371728143c3dSStefano Zampini     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
371828143c3dSStefano Zampini     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
371928143c3dSStefano Zampini   }
3720e7931f94SStefano Zampini   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
3721e7931f94SStefano Zampini   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
372228143c3dSStefano Zampini   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
3723e7931f94SStefano Zampini   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
3724e7931f94SStefano Zampini   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
372528143c3dSStefano Zampini   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
3726e7931f94SStefano Zampini   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
3727e7931f94SStefano Zampini   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
3728e7931f94SStefano Zampini   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
3729e7931f94SStefano Zampini   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
3730e7931f94SStefano Zampini   ierr = PetscFree(onodes);CHKERRQ(ierr);
373128143c3dSStefano Zampini   if (nis) {
373228143c3dSStefano Zampini     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
373328143c3dSStefano Zampini     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
373428143c3dSStefano Zampini     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
373528143c3dSStefano Zampini   }
373628143c3dSStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
373728143c3dSStefano Zampini   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
373828143c3dSStefano Zampini     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
373928143c3dSStefano Zampini     for (i=0;i<nis;i++) {
374028143c3dSStefano Zampini       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
374128143c3dSStefano Zampini     }
374228143c3dSStefano Zampini   }
3743e7931f94SStefano Zampini   PetscFunctionReturn(0);
3744e7931f94SStefano Zampini }
3745a57a6d2fSStefano Zampini 
374612edc857SStefano Zampini /* temporary hack into ksp private data structure */
3747af0996ceSBarry Smith #include <petsc/private/kspimpl.h>
374812edc857SStefano Zampini 
3749c8587f34SStefano Zampini #undef __FUNCT__
3750c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
3751c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
3752c8587f34SStefano Zampini {
3753c8587f34SStefano Zampini   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
3754c8587f34SStefano Zampini   PC_IS                  *pcis = (PC_IS*)pc->data;
375520a2ab83SStefano Zampini   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
37569881197aSStefano Zampini   MatNullSpace           CoarseNullSpace=NULL;
375720a2ab83SStefano Zampini   ISLocalToGlobalMapping coarse_islg;
37586e683305SStefano Zampini   IS                     coarse_is,*isarray;
37596e683305SStefano Zampini   PetscInt               i,im_active=-1,active_procs=-1;
37606e683305SStefano Zampini   PetscInt               nis,nisdofs,nisneu;
3761f9eb5b7dSStefano Zampini   PC                     pc_temp;
3762c8587f34SStefano Zampini   PCType                 coarse_pc_type;
3763c8587f34SStefano Zampini   KSPType                coarse_ksp_type;
3764f9eb5b7dSStefano Zampini   PetscBool              multilevel_requested,multilevel_allowed;
37654f3a063dSStefano Zampini   PetscBool              isredundant,isbddc,isnn,coarse_reuse;
37666e683305SStefano Zampini   Mat                    t_coarse_mat_is;
37676e683305SStefano Zampini   PetscInt               void_procs,ncoarse_ml,ncoarse_ds,ncoarse;
37686e683305SStefano Zampini   PetscMPIInt            all_procs;
376974e2c79eSStefano Zampini   PetscBool              csin_ml,csin_ds,csin,csin_type_simple,redist;
377068457ee5SStefano Zampini   PetscBool              compute_vecs = PETSC_FALSE;
377122bc73bbSStefano Zampini   PetscScalar            *array;
37729881197aSStefano Zampini   PetscErrorCode         ierr;
3773fdc09c96SStefano Zampini 
3774c8587f34SStefano Zampini   PetscFunctionBegin;
3775c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
377668457ee5SStefano 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 */
3777fa7f1dd8SStefano Zampini     PetscInt ocoarse_size;
37785a75c04eSSatish Balay     compute_vecs = PETSC_TRUE;
3779fa7f1dd8SStefano Zampini     ocoarse_size = pcbddc->coarse_size;
3780f4ddd8eeSStefano Zampini     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3781f4ddd8eeSStefano Zampini     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
3782f4ddd8eeSStefano Zampini     /* see if we can avoid some work */
3783fa7f1dd8SStefano Zampini     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
3784fa7f1dd8SStefano Zampini       if (ocoarse_size != pcbddc->coarse_size) { /* ...but with different size, so reset it and set reuse flag to false */
3785727cdba6SStefano Zampini         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3786fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_FALSE;
3787fa7f1dd8SStefano Zampini       } else { /* we can safely reuse already computed coarse matrix */
3788fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_TRUE;
3789f4ddd8eeSStefano Zampini       }
3790fa7f1dd8SStefano Zampini     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
3791fa7f1dd8SStefano Zampini       coarse_reuse = PETSC_FALSE;
3792f4ddd8eeSStefano Zampini     }
379370cf5478SStefano Zampini     /* reset any subassembling information */
379470cf5478SStefano Zampini     ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
37956e683305SStefano Zampini     ierr = ISDestroy(&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
37966e683305SStefano Zampini   } else { /* primal space is unchanged, so we can reuse coarse matrix */
3797fa7f1dd8SStefano Zampini     coarse_reuse = PETSC_TRUE;
3798f4ddd8eeSStefano Zampini   }
3799c8587f34SStefano Zampini 
38006e683305SStefano Zampini   /* count "active" (i.e. with positive local size) and "void" processes */
38012b510759SStefano Zampini   im_active = !!(pcis->n);
38022b510759SStefano Zampini   ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
38036e683305SStefano Zampini   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&all_procs);CHKERRQ(ierr);
38046e683305SStefano Zampini   void_procs = all_procs-active_procs;
38056e683305SStefano Zampini   csin_type_simple = PETSC_TRUE;
380674e2c79eSStefano Zampini   redist = PETSC_FALSE;
380722bc73bbSStefano Zampini   if (pcbddc->current_level && void_procs) {
38086e683305SStefano Zampini     csin_ml = PETSC_TRUE;
38096e683305SStefano Zampini     ncoarse_ml = void_procs;
3810779c1cceSStefano Zampini     /* it has no sense to redistribute on a set of processors larger than the number of active processes */
3811779c1cceSStefano Zampini     if (pcbddc->redistribute_coarse > 0 && pcbddc->redistribute_coarse < active_procs) {
381218a45a71SStefano Zampini       csin_ds = PETSC_TRUE;
381318a45a71SStefano Zampini       ncoarse_ds = pcbddc->redistribute_coarse;
381418a45a71SStefano Zampini       redist = PETSC_TRUE;
381518a45a71SStefano Zampini     } else {
38166e683305SStefano Zampini       csin_ds = PETSC_TRUE;
3817779c1cceSStefano Zampini       ncoarse_ds = active_procs;
3818779c1cceSStefano Zampini       redist = PETSC_TRUE;
381918a45a71SStefano Zampini     }
38206e683305SStefano Zampini   } else {
38216e683305SStefano Zampini     csin_ml = PETSC_FALSE;
38226e683305SStefano Zampini     ncoarse_ml = all_procs;
38236e683305SStefano Zampini     if (void_procs) {
38246e683305SStefano Zampini       csin_ds = PETSC_TRUE;
38256e683305SStefano Zampini       ncoarse_ds = void_procs;
38266e683305SStefano Zampini       csin_type_simple = PETSC_FALSE;
38276e683305SStefano Zampini     } else {
3828779c1cceSStefano Zampini       if (pcbddc->redistribute_coarse > 0 && pcbddc->redistribute_coarse < all_procs) {
382974e2c79eSStefano Zampini         csin_ds = PETSC_TRUE;
383074e2c79eSStefano Zampini         ncoarse_ds = pcbddc->redistribute_coarse;
383174e2c79eSStefano Zampini         redist = PETSC_TRUE;
383274e2c79eSStefano Zampini       } else {
38336e683305SStefano Zampini         csin_ds = PETSC_FALSE;
38346e683305SStefano Zampini         ncoarse_ds = all_procs;
38356e683305SStefano Zampini       }
38366e683305SStefano Zampini     }
383774e2c79eSStefano Zampini   }
38386e683305SStefano Zampini 
38396e683305SStefano Zampini   /*
38406e683305SStefano Zampini     test if we can go multilevel: three conditions must be satisfied:
38416e683305SStefano Zampini     - we have not exceeded the number of levels requested
38426e683305SStefano Zampini     - we can actually subassemble the active processes
38436e683305SStefano Zampini     - we can find a suitable number of MPI processes where we can place the subassembled problem
38446e683305SStefano Zampini   */
38456e683305SStefano Zampini   multilevel_allowed = PETSC_FALSE;
38466e683305SStefano Zampini   multilevel_requested = PETSC_FALSE;
38476e683305SStefano Zampini   if (pcbddc->current_level < pcbddc->max_levels) {
38486e683305SStefano Zampini     multilevel_requested = PETSC_TRUE;
38496e683305SStefano Zampini     if (active_procs/pcbddc->coarsening_ratio < 2 || ncoarse_ml/pcbddc->coarsening_ratio < 2) {
3850f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_FALSE;
38512b510759SStefano Zampini     } else {
3852f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_TRUE;
3853c8587f34SStefano Zampini     }
3854c8587f34SStefano Zampini   }
38556e683305SStefano Zampini   /* determine number of process partecipating to coarse solver */
38566e683305SStefano Zampini   if (multilevel_allowed) {
38576e683305SStefano Zampini     ncoarse = ncoarse_ml;
38586e683305SStefano Zampini     csin = csin_ml;
385958da7f69SStefano Zampini     redist = PETSC_FALSE;
38606e683305SStefano Zampini   } else {
38616e683305SStefano Zampini     ncoarse = ncoarse_ds;
38626e683305SStefano Zampini     csin = csin_ds;
38636e683305SStefano Zampini   }
3864e7931f94SStefano Zampini 
3865abbbba34SStefano Zampini   /* creates temporary l2gmap and IS for coarse indexes */
3866abbbba34SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
3867abbbba34SStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
3868abbbba34SStefano Zampini 
3869abbbba34SStefano Zampini   /* creates temporary MATIS object for coarse matrix */
387022bc73bbSStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
387122bc73bbSStefano Zampini   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
387222bc73bbSStefano Zampini   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
387322bc73bbSStefano Zampini   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
3874b9b85e73SStefano Zampini #if 0
3875b9b85e73SStefano Zampini   {
3876b9b85e73SStefano Zampini     PetscViewer viewer;
3877b9b85e73SStefano Zampini     char filename[256];
3878b9b85e73SStefano Zampini     sprintf(filename,"local_coarse_mat%d.m",PetscGlobalRank);
3879b9b85e73SStefano Zampini     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
3880b9b85e73SStefano Zampini     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
3881b9b85e73SStefano Zampini     ierr = MatView(coarse_submat_dense,viewer);CHKERRQ(ierr);
3882b9b85e73SStefano Zampini     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
3883b9b85e73SStefano Zampini   }
3884b9b85e73SStefano Zampini #endif
38856e683305SStefano 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);
38866e683305SStefano Zampini   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
38876e683305SStefano Zampini   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
38886e683305SStefano Zampini   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3889abbbba34SStefano Zampini   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
3890abbbba34SStefano Zampini 
38916e683305SStefano Zampini   /* compute dofs splitting and neumann boundaries for coarse dofs */
38926e683305SStefano Zampini   if (multilevel_allowed && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal) ) { /* protects from unneded computations */
38936e683305SStefano Zampini     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
38946e683305SStefano Zampini     const PetscInt         *idxs;
38956e683305SStefano Zampini     ISLocalToGlobalMapping tmap;
38966e683305SStefano Zampini 
38976e683305SStefano Zampini     /* create map between primal indices (in local representative ordering) and local primal numbering */
38980be93d54SStefano Zampini     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
38996e683305SStefano Zampini     /* allocate space for temporary storage */
3900854ce69bSBarry Smith     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
3901854ce69bSBarry Smith     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
39026e683305SStefano Zampini     /* allocate for IS array */
39036e683305SStefano Zampini     nisdofs = pcbddc->n_ISForDofsLocal;
39046e683305SStefano Zampini     nisneu = !!pcbddc->NeumannBoundariesLocal;
39056e683305SStefano Zampini     nis = nisdofs + nisneu;
3906854ce69bSBarry Smith     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
39076e683305SStefano Zampini     /* dofs splitting */
39086e683305SStefano Zampini     for (i=0;i<nisdofs;i++) {
39096e683305SStefano Zampini       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
39106e683305SStefano Zampini       ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
39116e683305SStefano Zampini       ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
39126e683305SStefano Zampini       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
39136e683305SStefano Zampini       ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
39146e683305SStefano Zampini       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
39156e683305SStefano Zampini       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pcbddc->ISForDofsLocal[i]),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
39166e683305SStefano Zampini       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
39176e683305SStefano Zampini     }
39186e683305SStefano Zampini     /* neumann boundaries */
39196e683305SStefano Zampini     if (pcbddc->NeumannBoundariesLocal) {
39206e683305SStefano Zampini       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
39216e683305SStefano Zampini       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
39226e683305SStefano Zampini       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
39236e683305SStefano Zampini       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
39246e683305SStefano Zampini       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
39256e683305SStefano Zampini       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
39266e683305SStefano Zampini       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pcbddc->NeumannBoundariesLocal),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
39276e683305SStefano Zampini       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
39286e683305SStefano Zampini     }
39296e683305SStefano Zampini     /* free memory */
39306e683305SStefano Zampini     ierr = PetscFree(tidxs);CHKERRQ(ierr);
39316e683305SStefano Zampini     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
39326e683305SStefano Zampini     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
39336e683305SStefano Zampini   } else {
39346e683305SStefano Zampini     nis = 0;
39356e683305SStefano Zampini     nisdofs = 0;
39366e683305SStefano Zampini     nisneu = 0;
39376e683305SStefano Zampini     isarray = NULL;
39386e683305SStefano Zampini   }
39396e683305SStefano Zampini   /* destroy no longer needed map */
39406e683305SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
39416e683305SStefano Zampini 
39426e683305SStefano Zampini   /* restrict on coarse candidates (if needed) */
39436e683305SStefano Zampini   coarse_mat_is = NULL;
39446e683305SStefano Zampini   if (csin) {
39456e683305SStefano Zampini     if (!pcbddc->coarse_subassembling_init ) { /* creates subassembling init pattern if not present */
394674e2c79eSStefano Zampini       if (redist) {
394774e2c79eSStefano Zampini         PetscMPIInt rank;
3948779c1cceSStefano Zampini         PetscInt    spc,n_spc_p1,dest[1],destsize;
394974e2c79eSStefano Zampini 
395074e2c79eSStefano Zampini         ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
395158da7f69SStefano Zampini         spc = active_procs/ncoarse;
395258da7f69SStefano Zampini         n_spc_p1 = active_procs%ncoarse;
3953779c1cceSStefano Zampini         if (im_active) {
3954779c1cceSStefano Zampini           destsize = 1;
395574e2c79eSStefano Zampini           if (rank > n_spc_p1*(spc+1)-1) {
395674e2c79eSStefano Zampini             dest[0] = n_spc_p1+(rank-(n_spc_p1*(spc+1)))/spc;
395774e2c79eSStefano Zampini           } else {
395874e2c79eSStefano Zampini             dest[0] = rank/(spc+1);
395974e2c79eSStefano Zampini           }
396074e2c79eSStefano Zampini         } else {
3961779c1cceSStefano Zampini           destsize = 0;
39626e683305SStefano Zampini         }
3963779c1cceSStefano Zampini         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),destsize,dest,PETSC_COPY_VALUES,&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
3964779c1cceSStefano Zampini       } else if (csin_type_simple) {
39656e683305SStefano Zampini         PetscMPIInt rank;
39666e683305SStefano Zampini         PetscInt    issize,isidx;
3967779c1cceSStefano Zampini 
39686e683305SStefano Zampini         ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
39696e683305SStefano Zampini         if (im_active) {
39706e683305SStefano Zampini           issize = 1;
39716e683305SStefano Zampini           isidx = (PetscInt)rank;
39726e683305SStefano Zampini         } else {
39736e683305SStefano Zampini           issize = 0;
39746e683305SStefano Zampini           isidx = -1;
39756e683305SStefano Zampini         }
39766e683305SStefano Zampini         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),issize,&isidx,PETSC_COPY_VALUES,&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
3977779c1cceSStefano Zampini       } else { /* get a suitable subassembling pattern from MATIS code */
39786e683305SStefano Zampini         ierr = MatISGetSubassemblingPattern(t_coarse_mat_is,ncoarse,PETSC_TRUE,&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
39796e683305SStefano Zampini       }
3980779c1cceSStefano Zampini 
3981779c1cceSStefano Zampini       /* we need to shift on coarse candidates either if we are not redistributing or we are redistributing and we have enough void processes */
3982779c1cceSStefano Zampini       if (!redist || ncoarse <= void_procs) {
3983779c1cceSStefano Zampini         PetscInt ncoarse_cand,tissize,*nisindices;
3984779c1cceSStefano Zampini         PetscInt *coarse_candidates;
3985779c1cceSStefano Zampini         const PetscInt* tisindices;
3986779c1cceSStefano Zampini 
3987779c1cceSStefano Zampini         /* get coarse candidates' ranks in pc communicator */
3988779c1cceSStefano Zampini         ierr = PetscMalloc1(all_procs,&coarse_candidates);CHKERRQ(ierr);
3989779c1cceSStefano Zampini         ierr = MPI_Allgather(&im_active,1,MPIU_INT,coarse_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3990779c1cceSStefano Zampini         for (i=0,ncoarse_cand=0;i<all_procs;i++) {
3991779c1cceSStefano Zampini           if (!coarse_candidates[i]) {
3992779c1cceSStefano Zampini             coarse_candidates[ncoarse_cand++]=i;
3993779c1cceSStefano Zampini           }
3994779c1cceSStefano Zampini         }
3995779c1cceSStefano Zampini         if (ncoarse_cand < ncoarse) SETERRQ2(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen! %d < %d",ncoarse_cand,ncoarse);
3996779c1cceSStefano Zampini 
3997779c1cceSStefano Zampini 
39986e683305SStefano Zampini         if (pcbddc->dbg_flag) {
39996e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
40006e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Subassembling pattern init (before shift)\n");CHKERRQ(ierr);
40016e683305SStefano Zampini           ierr = ISView(pcbddc->coarse_subassembling_init,pcbddc->dbg_viewer);CHKERRQ(ierr);
40026e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse candidates\n");CHKERRQ(ierr);
4003779c1cceSStefano Zampini           for (i=0;i<ncoarse_cand;i++) {
40046e683305SStefano Zampini             ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"%d ",coarse_candidates[i]);CHKERRQ(ierr);
40056e683305SStefano Zampini           }
40066e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"\n");CHKERRQ(ierr);
40076e683305SStefano Zampini           ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
40086e683305SStefano Zampini         }
40096e683305SStefano Zampini         /* shift the pattern on coarse candidates */
40106e683305SStefano Zampini         ierr = ISGetLocalSize(pcbddc->coarse_subassembling_init,&tissize);CHKERRQ(ierr);
40116e683305SStefano Zampini         ierr = ISGetIndices(pcbddc->coarse_subassembling_init,&tisindices);CHKERRQ(ierr);
4012854ce69bSBarry Smith         ierr = PetscMalloc1(tissize,&nisindices);CHKERRQ(ierr);
40136e683305SStefano Zampini         for (i=0;i<tissize;i++) nisindices[i] = coarse_candidates[tisindices[i]];
40146e683305SStefano Zampini         ierr = ISRestoreIndices(pcbddc->coarse_subassembling_init,&tisindices);CHKERRQ(ierr);
40156e683305SStefano Zampini         ierr = ISGeneralSetIndices(pcbddc->coarse_subassembling_init,tissize,nisindices,PETSC_OWN_POINTER);CHKERRQ(ierr);
40166e683305SStefano Zampini         ierr = PetscFree(coarse_candidates);CHKERRQ(ierr);
40176e683305SStefano Zampini       }
40186e683305SStefano Zampini       if (pcbddc->dbg_flag) {
40196e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
40206e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Subassembling pattern init\n");CHKERRQ(ierr);
40216e683305SStefano Zampini         ierr = ISView(pcbddc->coarse_subassembling_init,pcbddc->dbg_viewer);CHKERRQ(ierr);
40226e683305SStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
40236e683305SStefano Zampini       }
4024779c1cceSStefano Zampini     }
40256e683305SStefano Zampini     /* get temporary coarse mat in IS format restricted on coarse procs (plus additional index sets of isarray) */
40266e683305SStefano Zampini     ierr = MatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling_init,0,PETSC_TRUE,MAT_INITIAL_MATRIX,&coarse_mat_is,nis,isarray);CHKERRQ(ierr);
40276e683305SStefano Zampini   } else {
40286e683305SStefano Zampini     if (pcbddc->dbg_flag) {
40296e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
40306e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Subassembling pattern init not needed\n");CHKERRQ(ierr);
40316e683305SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
40326e683305SStefano Zampini     }
40336e683305SStefano Zampini     ierr = PetscObjectReference((PetscObject)t_coarse_mat_is);CHKERRQ(ierr);
40346e683305SStefano Zampini     coarse_mat_is = t_coarse_mat_is;
40356e683305SStefano Zampini   }
40366e683305SStefano Zampini 
40376e683305SStefano Zampini   /* create local to global scatters for coarse problem */
403868457ee5SStefano Zampini   if (compute_vecs) {
40396e683305SStefano Zampini     PetscInt lrows;
40406e683305SStefano Zampini     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
40416e683305SStefano Zampini     if (coarse_mat_is) {
40426e683305SStefano Zampini       ierr = MatGetLocalSize(coarse_mat_is,&lrows,NULL);CHKERRQ(ierr);
40436e683305SStefano Zampini     } else {
40446e683305SStefano Zampini       lrows = 0;
40456e683305SStefano Zampini     }
40466e683305SStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
40476e683305SStefano Zampini     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
40486e683305SStefano Zampini     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
40496e683305SStefano Zampini     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
40506e683305SStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
40516e683305SStefano Zampini   }
40526e683305SStefano Zampini   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
40536e683305SStefano Zampini   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
4054c8587f34SStefano Zampini 
4055f9eb5b7dSStefano Zampini   /* set defaults for coarse KSP and PC */
4056f9eb5b7dSStefano Zampini   if (multilevel_allowed) {
4057f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPRICHARDSON;
4058f9eb5b7dSStefano Zampini     coarse_pc_type = PCBDDC;
4059f9eb5b7dSStefano Zampini   } else {
4060f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPPREONLY;
4061f9eb5b7dSStefano Zampini     coarse_pc_type = PCREDUNDANT;
4062c8587f34SStefano Zampini   }
4063c8587f34SStefano Zampini 
40646e683305SStefano Zampini   /* print some info if requested */
40656e683305SStefano Zampini   if (pcbddc->dbg_flag) {
40666e683305SStefano Zampini     if (!multilevel_allowed) {
40676e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
40686e683305SStefano Zampini       if (multilevel_requested) {
40696e683305SStefano 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);
40706e683305SStefano Zampini       } else if (pcbddc->max_levels) {
40716e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
40726e683305SStefano Zampini       }
40736e683305SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
40746e683305SStefano Zampini     }
40756e683305SStefano Zampini   }
40766e683305SStefano Zampini 
4077f9eb5b7dSStefano Zampini   /* create the coarse KSP object only once with defaults */
40786e683305SStefano Zampini   if (coarse_mat_is) {
40796e683305SStefano Zampini     MatReuse coarse_mat_reuse;
40806a1308c2SStefano Zampini     PetscViewer dbg_viewer = NULL;
40816e683305SStefano Zampini     if (pcbddc->dbg_flag) {
40826e683305SStefano Zampini       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat_is));
40836e683305SStefano Zampini       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
40846e683305SStefano Zampini     }
4085f9eb5b7dSStefano Zampini     if (!pcbddc->coarse_ksp) {
4086312be037SStefano Zampini       char prefix[256],str_level[16];
4087e604994aSStefano Zampini       size_t len;
40886e683305SStefano Zampini       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat_is),&pcbddc->coarse_ksp);CHKERRQ(ierr);
4089c8587f34SStefano Zampini       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
4090f9eb5b7dSStefano Zampini       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
40915f76c7aeSStefano Zampini       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat_is,coarse_mat_is);CHKERRQ(ierr);
4092c8587f34SStefano Zampini       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
40936e683305SStefano Zampini       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
4094c8587f34SStefano Zampini       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
4095c8587f34SStefano Zampini       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
40963e3c6dadSStefano Zampini       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4097e604994aSStefano Zampini       /* prefix */
4098e604994aSStefano Zampini       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
4099e604994aSStefano Zampini       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
4100e604994aSStefano Zampini       if (!pcbddc->current_level) {
4101e604994aSStefano Zampini         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4102e604994aSStefano Zampini         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
4103c8587f34SStefano Zampini       } else {
4104e604994aSStefano Zampini         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
4105312be037SStefano Zampini         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
4106312be037SStefano Zampini         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
410734d6797cSStefano Zampini         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4108312be037SStefano Zampini         sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
4109e604994aSStefano Zampini         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
4110e604994aSStefano Zampini       }
4111e604994aSStefano Zampini       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
41123e3c6dadSStefano Zampini       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
41133e3c6dadSStefano Zampini       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
41143e3c6dadSStefano Zampini       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
41153e3c6dadSStefano Zampini       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
4116f9eb5b7dSStefano Zampini       /* allow user customization */
4117f9eb5b7dSStefano Zampini       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
41183e3c6dadSStefano Zampini     }
41193e3c6dadSStefano Zampini     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
41203e3c6dadSStefano Zampini     if (nisdofs) {
41213e3c6dadSStefano Zampini       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
41223e3c6dadSStefano Zampini       for (i=0;i<nisdofs;i++) {
41233e3c6dadSStefano Zampini         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
41243e3c6dadSStefano Zampini       }
41253e3c6dadSStefano Zampini     }
41263e3c6dadSStefano Zampini     if (nisneu) {
41273e3c6dadSStefano Zampini       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
41283e3c6dadSStefano Zampini       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
4129312be037SStefano Zampini     }
4130f9eb5b7dSStefano Zampini 
4131f9eb5b7dSStefano Zampini     /* get some info after set from options */
4132f9eb5b7dSStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
4133f9eb5b7dSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
4134f9eb5b7dSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
41354f3a063dSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
41366e683305SStefano Zampini     if (isbddc && !multilevel_allowed) { /* multilevel can only be requested via pc_bddc_set_levels */
4137f9eb5b7dSStefano Zampini       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
4138f9eb5b7dSStefano Zampini       isbddc = PETSC_FALSE;
4139f9eb5b7dSStefano Zampini     }
41404f3a063dSStefano Zampini     if (isredundant) {
41414f3a063dSStefano Zampini       KSP inner_ksp;
41424f3a063dSStefano Zampini       PC inner_pc;
41434f3a063dSStefano Zampini       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
41444f3a063dSStefano Zampini       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
41454f3a063dSStefano Zampini       ierr = PCFactorSetReuseFill(inner_pc,PETSC_TRUE);CHKERRQ(ierr);
41464f3a063dSStefano Zampini     }
4147f9eb5b7dSStefano Zampini 
4148f9eb5b7dSStefano Zampini     /* assemble coarse matrix */
4149fa7f1dd8SStefano Zampini     if (coarse_reuse) {
415081d9aea3SBarry Smith       ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
4151fa7f1dd8SStefano Zampini       ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
41526e683305SStefano Zampini       coarse_mat_reuse = MAT_REUSE_MATRIX;
4153fa7f1dd8SStefano Zampini     } else {
41546e683305SStefano Zampini       coarse_mat_reuse = MAT_INITIAL_MATRIX;
4155fa7f1dd8SStefano Zampini     }
4156c8587f34SStefano Zampini     if (isbddc || isnn) {
415722bc73bbSStefano Zampini       if (pcbddc->coarsening_ratio > 1) {
415870cf5478SStefano Zampini         if (!pcbddc->coarse_subassembling) { /* subassembling info is not present */
415928143c3dSStefano Zampini           ierr = MatISGetSubassemblingPattern(coarse_mat_is,active_procs/pcbddc->coarsening_ratio,PETSC_TRUE,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
416022b6e8a2SStefano Zampini           if (pcbddc->dbg_flag) {
41616e683305SStefano Zampini             ierr = PetscViewerASCIIPrintf(dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
41626e683305SStefano Zampini             ierr = PetscViewerASCIIPrintf(dbg_viewer,"Subassembling pattern\n");CHKERRQ(ierr);
41636e683305SStefano Zampini             ierr = ISView(pcbddc->coarse_subassembling,dbg_viewer);CHKERRQ(ierr);
41646e683305SStefano Zampini             ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
416522b6e8a2SStefano Zampini           }
416670cf5478SStefano Zampini         }
41676e683305SStefano Zampini         ierr = MatISSubassemble(coarse_mat_is,pcbddc->coarse_subassembling,0,PETSC_FALSE,coarse_mat_reuse,&coarse_mat,0,NULL);CHKERRQ(ierr);
416870cf5478SStefano Zampini       } else {
416922bc73bbSStefano Zampini         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
417022bc73bbSStefano Zampini         coarse_mat = coarse_mat_is;
417122bc73bbSStefano Zampini       }
417222bc73bbSStefano Zampini     } else {
41732e1e5fa4SStefano Zampini       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
4174c8587f34SStefano Zampini     }
4175c8587f34SStefano Zampini     ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
4176c8587f34SStefano Zampini 
4177c8587f34SStefano Zampini     /* propagate symmetry info to coarse matrix */
4178b9d89cd5SStefano Zampini     ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pcbddc->issym);CHKERRQ(ierr);
41795a16e3a0SStefano Zampini     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
4180c8587f34SStefano Zampini 
41816e683305SStefano Zampini     /* set operators */
41825f76c7aeSStefano Zampini     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
41836e683305SStefano Zampini     if (pcbddc->dbg_flag) {
41846e683305SStefano Zampini       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
41856e683305SStefano Zampini     }
41866e683305SStefano Zampini   } else { /* processes non partecipating to coarse solver (if any) */
41876e683305SStefano Zampini     coarse_mat = 0;
41886e683305SStefano Zampini   }
41896e683305SStefano Zampini   ierr = PetscFree(isarray);CHKERRQ(ierr);
4190b9b85e73SStefano Zampini #if 0
4191b9b85e73SStefano Zampini   {
4192b9b85e73SStefano Zampini     PetscViewer viewer;
4193b9b85e73SStefano Zampini     char filename[256];
4194b9b85e73SStefano Zampini     sprintf(filename,"coarse_mat.m");
4195b9b85e73SStefano Zampini     ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,filename,&viewer);CHKERRQ(ierr);
4196b9b85e73SStefano Zampini     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4197b9b85e73SStefano Zampini     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
4198b9b85e73SStefano Zampini     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4199b9b85e73SStefano Zampini   }
4200b9b85e73SStefano Zampini #endif
4201c8587f34SStefano Zampini 
4202c8587f34SStefano Zampini   /* Compute coarse null space (special handling by BDDC only) */
4203c8587f34SStefano Zampini   if (pcbddc->NullSpace) {
4204c8587f34SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,coarse_mat,&CoarseNullSpace);CHKERRQ(ierr);
420598a51de6SStefano Zampini   }
420698a51de6SStefano Zampini 
420798a51de6SStefano Zampini   if (pcbddc->coarse_ksp) {
420898a51de6SStefano Zampini     Vec crhs,csol;
420998a51de6SStefano Zampini     PetscBool ispreonly;
421098a51de6SStefano Zampini     if (CoarseNullSpace) {
4211c8587f34SStefano Zampini       if (isbddc) {
4212c8587f34SStefano Zampini         ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
4213c8587f34SStefano Zampini       } else {
4214c8587f34SStefano Zampini         ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
4215c8587f34SStefano Zampini       }
4216c8587f34SStefano Zampini     }
4217f9eb5b7dSStefano Zampini     /* setup coarse ksp */
4218f9eb5b7dSStefano Zampini     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
4219f347579bSStefano Zampini     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
4220f347579bSStefano Zampini     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
42216e683305SStefano Zampini     /* hack */
4222f347579bSStefano Zampini     if (!csol) {
42232a7a6963SBarry Smith       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
4224f9eb5b7dSStefano Zampini     }
4225f347579bSStefano Zampini     if (!crhs) {
42262a7a6963SBarry Smith       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
4227f347579bSStefano Zampini     }
4228cbcc2c2aSStefano Zampini     /* Check coarse problem if in debug mode or if solving with an iterative method */
4229cbcc2c2aSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
42306e683305SStefano Zampini     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
4231c8587f34SStefano Zampini       KSP       check_ksp;
42322b510759SStefano Zampini       KSPType   check_ksp_type;
4233c8587f34SStefano Zampini       PC        check_pc;
42346e683305SStefano Zampini       Vec       check_vec,coarse_vec;
42356a1308c2SStefano Zampini       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
42362b510759SStefano Zampini       PetscInt  its;
42376e683305SStefano Zampini       PetscBool compute_eigs;
42386e683305SStefano Zampini       PetscReal *eigs_r,*eigs_c;
42396e683305SStefano Zampini       PetscInt  neigs;
42408e185a42SStefano Zampini       const char *prefix;
4241c8587f34SStefano Zampini 
42422b510759SStefano Zampini       /* Create ksp object suitable for estimation of extreme eigenvalues */
42436e683305SStefano Zampini       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
424423ee1639SBarry Smith       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
4245f4ddd8eeSStefano Zampini       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
42462b510759SStefano Zampini       if (ispreonly) {
42472b510759SStefano Zampini         check_ksp_type = KSPPREONLY;
42486e683305SStefano Zampini         compute_eigs = PETSC_FALSE;
42492b510759SStefano Zampini       } else {
4250cbcc2c2aSStefano Zampini         check_ksp_type = KSPGMRES;
42516e683305SStefano Zampini         compute_eigs = PETSC_TRUE;
4252c8587f34SStefano Zampini       }
4253c8587f34SStefano Zampini       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
42546e683305SStefano Zampini       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
42556e683305SStefano Zampini       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
42566e683305SStefano Zampini       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
4257a7dc3881SStefano Zampini       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
4258a7dc3881SStefano Zampini       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
4259a7dc3881SStefano Zampini       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
4260a7dc3881SStefano Zampini       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
4261c8587f34SStefano Zampini       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
4262c8587f34SStefano Zampini       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
4263c8587f34SStefano Zampini       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
4264c8587f34SStefano Zampini       /* create random vec */
42656e683305SStefano Zampini       ierr = KSPGetSolution(pcbddc->coarse_ksp,&coarse_vec);CHKERRQ(ierr);
42666e683305SStefano Zampini       ierr = VecDuplicate(coarse_vec,&check_vec);CHKERRQ(ierr);
4267c8587f34SStefano Zampini       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
4268c8587f34SStefano Zampini       if (CoarseNullSpace) {
4269c8587f34SStefano Zampini         ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
4270c8587f34SStefano Zampini       }
42716e683305SStefano Zampini       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
4272c8587f34SStefano Zampini       /* solve coarse problem */
42736e683305SStefano Zampini       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
4274c8587f34SStefano Zampini       if (CoarseNullSpace) {
42756e683305SStefano Zampini         ierr = MatNullSpaceRemove(CoarseNullSpace,coarse_vec);CHKERRQ(ierr);
4276c8587f34SStefano Zampini       }
4277cbcc2c2aSStefano Zampini       /* set eigenvalue estimation if preonly has not been requested */
42786e683305SStefano Zampini       if (compute_eigs) {
4279854ce69bSBarry Smith         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
4280854ce69bSBarry Smith         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
42816e683305SStefano Zampini         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
42826e683305SStefano Zampini         lambda_max = eigs_r[neigs-1];
42836e683305SStefano Zampini         lambda_min = eigs_r[0];
42846e683305SStefano Zampini         if (pcbddc->use_coarse_estimates) {
42856e683305SStefano Zampini           if (lambda_max>lambda_min) {
4286cbcc2c2aSStefano Zampini             ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max,lambda_min);CHKERRQ(ierr);
4287cbcc2c2aSStefano Zampini             ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
4288cbcc2c2aSStefano Zampini           }
4289c8587f34SStefano Zampini         }
4290c8587f34SStefano Zampini       }
4291cbcc2c2aSStefano Zampini 
4292c8587f34SStefano Zampini       /* check coarse problem residual error */
42936e683305SStefano Zampini       if (pcbddc->dbg_flag) {
42946e683305SStefano Zampini         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
42956e683305SStefano Zampini         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
42966e683305SStefano Zampini         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
4297c8587f34SStefano Zampini         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
42986e683305SStefano Zampini         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
42996e683305SStefano Zampini         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
4300c8587f34SStefano Zampini         ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
4301779c1cceSStefano Zampini         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
43026e683305SStefano Zampini         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
43036e683305SStefano Zampini         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
43046e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
43056e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
43066e683305SStefano Zampini         if (compute_eigs) {
43076e683305SStefano Zampini           PetscReal lambda_max_s,lambda_min_s;
4308deec49d1SStefano Zampini           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
4309c8587f34SStefano Zampini           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
43106e683305SStefano Zampini           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
43116e683305SStefano 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);
43126e683305SStefano Zampini           for (i=0;i<neigs;i++) {
43136e683305SStefano Zampini             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
4314c8587f34SStefano Zampini           }
43156e683305SStefano Zampini         }
43166e683305SStefano Zampini         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
43176e683305SStefano Zampini         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
43186e683305SStefano Zampini       }
4319c8587f34SStefano Zampini       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
43206e683305SStefano Zampini       if (compute_eigs) {
43216e683305SStefano Zampini         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
43226e683305SStefano Zampini         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
4323c8587f34SStefano Zampini       }
43246e683305SStefano Zampini     }
43256e683305SStefano Zampini   }
4326cbcc2c2aSStefano Zampini   /* print additional info */
4327cbcc2c2aSStefano Zampini   if (pcbddc->dbg_flag) {
43286e683305SStefano Zampini     /* waits until all processes reaches this point */
43296e683305SStefano Zampini     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
4330cbcc2c2aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
4331cbcc2c2aSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4332cbcc2c2aSStefano Zampini   }
4333cbcc2c2aSStefano Zampini 
43342b510759SStefano Zampini   /* free memory */
4335c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
4336fdc635d7SStefano Zampini   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
4337c8587f34SStefano Zampini   PetscFunctionReturn(0);
4338c8587f34SStefano Zampini }
4339674ae819SStefano Zampini 
4340f34684f1SStefano Zampini #undef __FUNCT__
4341f34684f1SStefano Zampini #define __FUNCT__ "PCBDDCComputePrimalNumbering"
4342f34684f1SStefano Zampini PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
4343f34684f1SStefano Zampini {
4344f34684f1SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4345f34684f1SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
4346f34684f1SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
434773be2a3aSStefano Zampini   PetscInt       i,coarse_size=0;
434873be2a3aSStefano Zampini   PetscInt       *local_primal_indices=NULL;
4349f34684f1SStefano Zampini   PetscErrorCode ierr;
4350f34684f1SStefano Zampini 
4351f34684f1SStefano Zampini   PetscFunctionBegin;
4352f34684f1SStefano Zampini   /* Compute global number of coarse dofs */
435389c96988SStefano Zampini   if (!pcbddc->primal_indices_local_idxs && pcbddc->local_primal_size) {
435489c96988SStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Local primal indices have not been created");
4355727cdba6SStefano Zampini   }
4356727cdba6SStefano 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);
4357f34684f1SStefano Zampini 
4358f34684f1SStefano Zampini   /* check numbering */
4359f34684f1SStefano Zampini   if (pcbddc->dbg_flag) {
4360f34684f1SStefano Zampini     PetscScalar coarsesum,*array;
4361b9b85e73SStefano Zampini     PetscBool set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
4362f34684f1SStefano Zampini 
4363f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4364f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4365f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
43660fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
4367f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
4368f34684f1SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
4369727cdba6SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
4370f34684f1SStefano Zampini     }
4371f34684f1SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
4372f34684f1SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
4373f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
4374f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4375f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4376f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4377f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4378f34684f1SStefano Zampini     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4379f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
4380f34684f1SStefano Zampini       if (array[i] == 1.0) {
4381b9b85e73SStefano Zampini         set_error = PETSC_TRUE;
4382f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d owned by a single process!\n",PetscGlobalRank,i);CHKERRQ(ierr);
4383f34684f1SStefano Zampini       }
4384f34684f1SStefano Zampini     }
4385b9b85e73SStefano Zampini     ierr = MPI_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4386f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4387f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
4388f34684f1SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
4389f34684f1SStefano Zampini     }
4390f34684f1SStefano Zampini     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4391f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
4392f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4393f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4394f34684f1SStefano Zampini     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
4395f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
4396b9b85e73SStefano Zampini     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
4397ca8b9ea9SStefano Zampini       PetscInt *gidxs;
4398ca8b9ea9SStefano Zampini 
4399ca8b9ea9SStefano Zampini       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
4400ca8b9ea9SStefano Zampini       ierr = ISLocalToGlobalMappingApply(matis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
4401f34684f1SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
4402f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4403f34684f1SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
4404f34684f1SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
44054bc2dc4bSStefano 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);
4406f34684f1SStefano Zampini       }
4407f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4408ca8b9ea9SStefano Zampini       ierr = PetscFree(gidxs);CHKERRQ(ierr);
4409f34684f1SStefano Zampini     }
4410f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4411302440fdSBarry Smith     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
4412f34684f1SStefano Zampini   }
44138bec7fa6SStefano Zampini   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
4414f34684f1SStefano Zampini   /* get back data */
4415f34684f1SStefano Zampini   *coarse_size_n = coarse_size;
4416f34684f1SStefano Zampini   *local_primal_indices_n = local_primal_indices;
4417674ae819SStefano Zampini   PetscFunctionReturn(0);
4418674ae819SStefano Zampini }
4419674ae819SStefano Zampini 
4420e456f2a8SStefano Zampini #undef __FUNCT__
4421e456f2a8SStefano Zampini #define __FUNCT__ "PCBDDCGlobalToLocal"
4422a7dc3881SStefano Zampini PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
4423e456f2a8SStefano Zampini {
4424e456f2a8SStefano Zampini   IS             localis_t;
4425a7dc3881SStefano Zampini   PetscInt       i,lsize,*idxs,n;
4426e456f2a8SStefano Zampini   PetscScalar    *vals;
4427e456f2a8SStefano Zampini   PetscErrorCode ierr;
4428e456f2a8SStefano Zampini 
4429e456f2a8SStefano Zampini   PetscFunctionBegin;
4430a7dc3881SStefano Zampini   /* get indices in local ordering exploiting local to global map */
4431e456f2a8SStefano Zampini   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
4432854ce69bSBarry Smith   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
4433e456f2a8SStefano Zampini   for (i=0;i<lsize;i++) vals[i] = 1.0;
4434e456f2a8SStefano Zampini   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
4435a7dc3881SStefano Zampini   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
4436a7dc3881SStefano Zampini   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
44371035eff8SStefano Zampini   if (idxs) { /* multilevel guard */
4438a7dc3881SStefano Zampini     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
44391035eff8SStefano Zampini   }
4440a7dc3881SStefano Zampini   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
4441e456f2a8SStefano Zampini   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
4442e456f2a8SStefano Zampini   ierr = PetscFree(vals);CHKERRQ(ierr);
4443a7dc3881SStefano Zampini   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
4444a7dc3881SStefano Zampini   /* now compute set in local ordering */
4445a7dc3881SStefano Zampini   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4446a7dc3881SStefano Zampini   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4447a7dc3881SStefano Zampini   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
4448a7dc3881SStefano Zampini   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
4449a7dc3881SStefano Zampini   for (i=0,lsize=0;i<n;i++) {
4450ff92baa0SMatthew G. Knepley     if (PetscRealPart(vals[i]) > 0.5) {
4451e456f2a8SStefano Zampini       lsize++;
4452e456f2a8SStefano Zampini     }
4453e456f2a8SStefano Zampini   }
4454854ce69bSBarry Smith   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
4455a7dc3881SStefano Zampini   for (i=0,lsize=0;i<n;i++) {
4456ff92baa0SMatthew G. Knepley     if (PetscRealPart(vals[i]) > 0.5) {
4457e456f2a8SStefano Zampini       idxs[lsize++] = i;
4458e456f2a8SStefano Zampini     }
4459e456f2a8SStefano Zampini   }
4460a7dc3881SStefano Zampini   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
4461a7dc3881SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
4462e456f2a8SStefano Zampini   *localis = localis_t;
4463e456f2a8SStefano Zampini   PetscFunctionReturn(0);
4464e456f2a8SStefano Zampini }
4465906d46d4SStefano Zampini 
4466906d46d4SStefano Zampini /* the next two functions will be called in KSPMatMult if a change of basis has been requested */
4467906d46d4SStefano Zampini #undef __FUNCT__
4468906d46d4SStefano Zampini #define __FUNCT__ "PCBDDCMatMult_Private"
4469906d46d4SStefano Zampini static PetscErrorCode PCBDDCMatMult_Private(Mat A, Vec x, Vec y)
4470906d46d4SStefano Zampini {
4471906d46d4SStefano Zampini   PCBDDCChange_ctx change_ctx;
4472906d46d4SStefano Zampini   PetscErrorCode   ierr;
4473906d46d4SStefano Zampini 
4474906d46d4SStefano Zampini   PetscFunctionBegin;
4475906d46d4SStefano Zampini   ierr = MatShellGetContext(A,&change_ctx);CHKERRQ(ierr);
4476906d46d4SStefano Zampini   ierr = MatMult(change_ctx->global_change,x,change_ctx->work[0]);CHKERRQ(ierr);
4477906d46d4SStefano Zampini   ierr = MatMult(change_ctx->original_mat,change_ctx->work[0],change_ctx->work[1]);CHKERRQ(ierr);
4478906d46d4SStefano Zampini   ierr = MatMultTranspose(change_ctx->global_change,change_ctx->work[1],y);CHKERRQ(ierr);
4479906d46d4SStefano Zampini   PetscFunctionReturn(0);
4480906d46d4SStefano Zampini }
4481906d46d4SStefano Zampini 
4482906d46d4SStefano Zampini #undef __FUNCT__
4483906d46d4SStefano Zampini #define __FUNCT__ "PCBDDCMatMultTranspose_Private"
4484906d46d4SStefano Zampini static PetscErrorCode PCBDDCMatMultTranspose_Private(Mat A, Vec x, Vec y)
4485906d46d4SStefano Zampini {
4486906d46d4SStefano Zampini   PCBDDCChange_ctx change_ctx;
4487906d46d4SStefano Zampini   PetscErrorCode   ierr;
4488906d46d4SStefano Zampini 
4489906d46d4SStefano Zampini   PetscFunctionBegin;
4490906d46d4SStefano Zampini   ierr = MatShellGetContext(A,&change_ctx);CHKERRQ(ierr);
4491906d46d4SStefano Zampini   ierr = MatMult(change_ctx->global_change,x,change_ctx->work[0]);CHKERRQ(ierr);
4492906d46d4SStefano Zampini   ierr = MatMultTranspose(change_ctx->original_mat,change_ctx->work[0],change_ctx->work[1]);CHKERRQ(ierr);
4493906d46d4SStefano Zampini   ierr = MatMultTranspose(change_ctx->global_change,change_ctx->work[1],y);CHKERRQ(ierr);
4494906d46d4SStefano Zampini   PetscFunctionReturn(0);
4495906d46d4SStefano Zampini }
4496b96c3477SStefano Zampini 
4497b96c3477SStefano Zampini #undef __FUNCT__
4498b96c3477SStefano Zampini #define __FUNCT__ "PCBDDCSetUpSubSchurs"
449908122e43SStefano Zampini PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
4500b96c3477SStefano Zampini {
4501a64f4aa4SStefano Zampini   PC_IS               *pcis=(PC_IS*)pc->data;
4502b96c3477SStefano Zampini   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
4503b96c3477SStefano Zampini   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
4504a64f4aa4SStefano Zampini   Mat                 S_j;
4505b96c3477SStefano Zampini   PetscInt            *used_xadj,*used_adjncy;
4506b96c3477SStefano Zampini   PetscBool           free_used_adj;
4507b96c3477SStefano Zampini   PetscErrorCode      ierr;
4508b96c3477SStefano Zampini 
4509b96c3477SStefano Zampini   PetscFunctionBegin;
4510b96c3477SStefano Zampini   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
4511b96c3477SStefano Zampini   free_used_adj = PETSC_FALSE;
451208122e43SStefano Zampini   if (pcbddc->sub_schurs_layers == -1) {
4513b96c3477SStefano Zampini     used_xadj = NULL;
4514b96c3477SStefano Zampini     used_adjncy = NULL;
4515b96c3477SStefano Zampini   } else {
451608122e43SStefano Zampini     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
451708122e43SStefano Zampini       used_xadj = pcbddc->mat_graph->xadj;
451808122e43SStefano Zampini       used_adjncy = pcbddc->mat_graph->adjncy;
451908122e43SStefano Zampini     } else if (pcbddc->computed_rowadj) {
4520b96c3477SStefano Zampini       used_xadj = pcbddc->mat_graph->xadj;
4521b96c3477SStefano Zampini       used_adjncy = pcbddc->mat_graph->adjncy;
4522b96c3477SStefano Zampini     } else {
45232fffb893SStefano Zampini       PetscBool      flg_row=PETSC_FALSE;
4524b96c3477SStefano Zampini       const PetscInt *xadj,*adjncy;
4525b96c3477SStefano Zampini       PetscInt       nvtxs;
4526b96c3477SStefano Zampini 
45272fffb893SStefano Zampini       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
45282fffb893SStefano Zampini       if (flg_row) {
4529b96c3477SStefano Zampini         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
4530b96c3477SStefano Zampini         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
4531b96c3477SStefano Zampini         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
4532b96c3477SStefano Zampini         free_used_adj = PETSC_TRUE;
45332fffb893SStefano Zampini       } else {
45342fffb893SStefano Zampini         pcbddc->sub_schurs_layers = -1;
45352fffb893SStefano Zampini         used_xadj = NULL;
45362fffb893SStefano Zampini         used_adjncy = NULL;
45372fffb893SStefano Zampini       }
45382fffb893SStefano Zampini       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4539b96c3477SStefano Zampini     }
4540b96c3477SStefano Zampini   }
4541d5574798SStefano Zampini 
4542d5574798SStefano Zampini   /* setup sub_schurs data */
4543a64f4aa4SStefano Zampini   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
4544a64f4aa4SStefano Zampini   if (!sub_schurs->use_mumps) {
4545a64f4aa4SStefano Zampini     /* pcbddc->ksp_D up to date only if not using MUMPS */
4546a64f4aa4SStefano Zampini     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
4547a64f4aa4SStefano 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);
4548a64f4aa4SStefano Zampini   } else {
4549a64f4aa4SStefano 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);
4550a64f4aa4SStefano Zampini   }
4551a64f4aa4SStefano Zampini   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
4552b96c3477SStefano Zampini 
4553b96c3477SStefano Zampini   /* free adjacency */
4554b96c3477SStefano Zampini   if (free_used_adj) {
4555b96c3477SStefano Zampini     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
4556b96c3477SStefano Zampini   }
4557b96c3477SStefano Zampini   PetscFunctionReturn(0);
4558b96c3477SStefano Zampini }
4559b96c3477SStefano Zampini 
4560b96c3477SStefano Zampini #undef __FUNCT__
4561b96c3477SStefano Zampini #define __FUNCT__ "PCBDDCInitSubSchurs"
456208122e43SStefano Zampini PetscErrorCode PCBDDCInitSubSchurs(PC pc)
4563b96c3477SStefano Zampini {
4564b96c3477SStefano Zampini   PC_IS               *pcis=(PC_IS*)pc->data;
4565b96c3477SStefano Zampini   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
4566b96c3477SStefano Zampini   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
4567b96c3477SStefano Zampini   PCBDDCGraph         graph;
4568b96c3477SStefano Zampini   PetscErrorCode      ierr;
4569b96c3477SStefano Zampini 
4570b96c3477SStefano Zampini   PetscFunctionBegin;
4571b96c3477SStefano Zampini   /* attach interface graph for determining subsets */
457208122e43SStefano Zampini   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
4573b96c3477SStefano Zampini     IS verticesIS;
4574b96c3477SStefano Zampini 
4575b96c3477SStefano Zampini     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
4576b96c3477SStefano Zampini     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
45777fb0e2dbSStefano Zampini     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global);CHKERRQ(ierr);
4578b96c3477SStefano Zampini     ierr = PCBDDCGraphSetUp(graph,0,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticesIS);CHKERRQ(ierr);
4579b96c3477SStefano Zampini     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
4580b96c3477SStefano Zampini     ierr = ISDestroy(&verticesIS);CHKERRQ(ierr);
4581b96c3477SStefano Zampini /*
4582b96c3477SStefano Zampini     if (pcbddc->dbg_flag) {
4583b96c3477SStefano Zampini       ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
4584b96c3477SStefano Zampini     }
4585b96c3477SStefano Zampini */
4586b96c3477SStefano Zampini   } else {
4587b96c3477SStefano Zampini     graph = pcbddc->mat_graph;
4588b96c3477SStefano Zampini   }
4589b96c3477SStefano Zampini 
4590b96c3477SStefano Zampini   /* sub_schurs init */
4591a64f4aa4SStefano Zampini   ierr = PCBDDCSubSchursInit(sub_schurs,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap);CHKERRQ(ierr);
4592a64f4aa4SStefano Zampini 
4593b96c3477SStefano Zampini   /* free graph struct */
459408122e43SStefano Zampini   if (pcbddc->sub_schurs_rebuild) {
4595b96c3477SStefano Zampini     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
4596b96c3477SStefano Zampini   }
4597b96c3477SStefano Zampini   PetscFunctionReturn(0);
4598b96c3477SStefano Zampini }
4599