xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 5a95e1ceb00aaf913daa567a70a604cb4fd63728)
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   PetscScalar     *Smult,*Seigv;
2008122e43SStefano Zampini   PetscReal       *eigs,thresh;
211b968477SStefano Zampini   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
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;
5918a45a71SStefano Zampini   nmin = pcbddc->adaptive_nmin > -1 ? pcbddc->adaptive_nmin : 1;
6008122e43SStefano Zampini   nmax = PetscMax(nmin,nmax);
6108122e43SStefano Zampini 
6208122e43SStefano Zampini   /* allocate lapack workspace */
6308122e43SStefano Zampini   cum = cum2 = 0;
6408122e43SStefano Zampini   maxneigs = 0;
6508122e43SStefano Zampini   for (i=0;i<sub_schurs->n_subs;i++) {
6608122e43SStefano Zampini     if (PetscBTLookup(sub_schurs->computed_Stilda_subs,i)) {
6708122e43SStefano Zampini       PetscInt n,subset_size;
6808122e43SStefano Zampini       ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
6908122e43SStefano Zampini       n = PetscMin(subset_size,nmax);
7008122e43SStefano Zampini       cum += subset_size*n;
7108122e43SStefano Zampini       cum2 += n;
7208122e43SStefano Zampini       maxneigs = PetscMax(maxneigs,n);
7308122e43SStefano Zampini     }
7408122e43SStefano Zampini   }
7508122e43SStefano Zampini 
7608122e43SStefano Zampini   if (mss) {
779ab7bb16SStefano Zampini     if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
7808122e43SStefano Zampini       PetscBLASInt B_itype = 1;
7908122e43SStefano Zampini       PetscBLASInt B_N = mss;
804c6709b3SStefano Zampini       PetscReal    zero = 0.0;
814c6709b3SStefano Zampini       PetscReal    eps = 0.0; /* dlamch? */
8208122e43SStefano Zampini 
8308122e43SStefano Zampini       B_lwork = -1;
8408122e43SStefano Zampini       S = NULL;
8508122e43SStefano Zampini       St = NULL;
86a58a30b4SStefano Zampini       eigs = NULL;
87a58a30b4SStefano Zampini       eigv = NULL;
88a58a30b4SStefano Zampini       B_iwork = NULL;
89a58a30b4SStefano Zampini       B_ifail = NULL;
908bec7fa6SStefano Zampini       thresh = 1.0;
9108122e43SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
9208122e43SStefano Zampini #if defined(PETSC_USE_COMPLEX)
9308122e43SStefano 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));
9408122e43SStefano Zampini #else
9508122e43SStefano 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));
9608122e43SStefano Zampini #endif
9708122e43SStefano Zampini       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
9808122e43SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
9908122e43SStefano Zampini     } else {
10008122e43SStefano Zampini         /* TODO */
10108122e43SStefano Zampini     }
10208122e43SStefano Zampini   } else {
10308122e43SStefano Zampini     lwork = 0;
10408122e43SStefano Zampini   }
10508122e43SStefano Zampini 
10608122e43SStefano Zampini   nv = 0;
1078bec7fa6SStefano Zampini   if (sub_schurs->is_Ej_com && pcbddc->use_vertices) { /* complement of subsets, each entry is a vertex */
10808122e43SStefano Zampini     ierr = ISGetLocalSize(sub_schurs->is_Ej_com,&nv);CHKERRQ(ierr);
10908122e43SStefano Zampini   }
1104c6709b3SStefano Zampini   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
11108122e43SStefano Zampini   ierr = PetscMalloc7(mss*mss,&S,mss*mss,&St,mss*mss,&eigv,mss,&eigs,
11208122e43SStefano Zampini                       B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
11308122e43SStefano Zampini #if defined(PETSC_USE_COMPLEX)
11408122e43SStefano Zampini   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
11508122e43SStefano Zampini #endif
11608122e43SStefano Zampini   ierr = PetscMalloc2(mss*mss,&Smult,mss*mss,&Seigv);CHKERRQ(ierr);
11708122e43SStefano Zampini   ierr = PetscMalloc4(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
11808122e43SStefano Zampini                       nv+cum2+1,&pcbddc->adaptive_constraints_ptrs,
11908122e43SStefano Zampini                       nv+cum,&pcbddc->adaptive_constraints_idxs,
12008122e43SStefano Zampini                       nv+cum,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
12108122e43SStefano Zampini   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
12208122e43SStefano Zampini 
12308122e43SStefano Zampini   maxneigs = 0;
12408122e43SStefano Zampini   cum = cum2 = cumarray = 0;
1258bec7fa6SStefano Zampini   if (sub_schurs->is_Ej_com && pcbddc->use_vertices) {
12608122e43SStefano Zampini     const PetscInt *idxs;
12708122e43SStefano Zampini 
12808122e43SStefano Zampini     ierr = ISGetIndices(sub_schurs->is_Ej_com,&idxs);CHKERRQ(ierr);
12908122e43SStefano Zampini     for (cum=0;cum<nv;cum++) {
13008122e43SStefano Zampini       pcbddc->adaptive_constraints_n[cum] = 1;
13108122e43SStefano Zampini       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
13208122e43SStefano Zampini       pcbddc->adaptive_constraints_ptrs[cum] = cum;
13308122e43SStefano Zampini       pcbddc->adaptive_constraints_data[cum] = 1.0;
13408122e43SStefano Zampini     }
13508122e43SStefano Zampini     cum2 = cum;
13608122e43SStefano Zampini     ierr = ISRestoreIndices(sub_schurs->is_Ej_com,&idxs);CHKERRQ(ierr);
13708122e43SStefano Zampini   }
13808122e43SStefano Zampini 
13908122e43SStefano Zampini   if (mss) { /* multilevel */
14008122e43SStefano Zampini     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
14108122e43SStefano Zampini     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
14208122e43SStefano Zampini   }
14308122e43SStefano Zampini 
14408122e43SStefano Zampini   for (i=0;i<sub_schurs->n_subs;i++) {
14508122e43SStefano Zampini     PetscInt j,subset_size;
14608122e43SStefano Zampini 
14708122e43SStefano Zampini     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
14808122e43SStefano Zampini     if (PetscBTLookup(sub_schurs->computed_Stilda_subs,i)) {
14908122e43SStefano Zampini       const PetscInt *idxs;
1504c6709b3SStefano Zampini       PetscScalar    one = 1.0,scalar_zero = 0.0;
1514c6709b3SStefano Zampini       PetscReal      zero=0.0;
15208122e43SStefano Zampini       PetscBLASInt   B_N;
15308122e43SStefano Zampini 
15408122e43SStefano Zampini       /* S should be copied since we need it for deluxe scaling */
1559ab7bb16SStefano Zampini       if (sub_schurs->is_hermitian) {
15608122e43SStefano Zampini         PetscInt j;
15708122e43SStefano Zampini         for (j=0;j<subset_size;j++) {
15808122e43SStefano Zampini           ierr = PetscMemcpy(S+j*(subset_size+1),Sarray+cumarray+j*(subset_size+1),(subset_size-j)*sizeof(PetscScalar));CHKERRQ(ierr);
15908122e43SStefano Zampini         }
16008122e43SStefano Zampini         for (j=0;j<subset_size;j++) {
16108122e43SStefano Zampini           ierr = PetscMemcpy(St+j*(subset_size+1),Starray+cumarray+j*(subset_size+1),(subset_size-j)*sizeof(PetscScalar));CHKERRQ(ierr);
16208122e43SStefano Zampini         }
16308122e43SStefano Zampini       } else {
16408122e43SStefano Zampini         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
16508122e43SStefano Zampini         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
16608122e43SStefano Zampini       }
16708122e43SStefano Zampini       /* is always this the right matrix? */
16808122e43SStefano Zampini       ierr = PetscMemcpy(Smult,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
16908122e43SStefano Zampini 
17008122e43SStefano Zampini       /* we could reuse space already allocated when building sum_S_Ej_tilda_all */
17108122e43SStefano Zampini       /* St = Starray+cumarray; */
1728bec7fa6SStefano Zampini       ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
1738bec7fa6SStefano Zampini       if (pcbddc->adaptive_threshold > 1.0) { /* this is an heuristic for edges */
1748bec7fa6SStefano Zampini         thresh = (1.*pcbddc->mat_graph->count[idxs[0]])/(pcbddc->adaptive_threshold);
1758bec7fa6SStefano Zampini       } else {
1768bec7fa6SStefano Zampini         thresh = 1.0;
1778bec7fa6SStefano Zampini       }
17808122e43SStefano Zampini 
1799ab7bb16SStefano Zampini       if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
18008122e43SStefano Zampini         PetscBLASInt B_itype = 1;
18108122e43SStefano Zampini         PetscBLASInt B_IL = 1, B_IU;
1824c6709b3SStefano Zampini         PetscReal    eps = -1.0; /* dlamch? */
1839552c7c7SStefano Zampini         PetscInt     nmin_s;
18408122e43SStefano Zampini 
1858bec7fa6SStefano Zampini         ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
18608122e43SStefano Zampini         /* ask for eigenvalues lower than thresh */
187fd14bc51SStefano Zampini         if (pcbddc->dbg_flag) {
1888bec7fa6SStefano 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]]);
189fd14bc51SStefano Zampini         }
19008122e43SStefano Zampini         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
19108122e43SStefano Zampini #if defined(PETSC_USE_COMPLEX)
19208122e43SStefano Zampini         PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
19308122e43SStefano Zampini #else
19408122e43SStefano Zampini         PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
19508122e43SStefano Zampini #endif
19608122e43SStefano Zampini         ierr = PetscFPTrapPop();CHKERRQ(ierr);
19708122e43SStefano Zampini         if (B_ierr) {
19808122e43SStefano Zampini           if (B_ierr < 0 ) {
19908122e43SStefano Zampini             SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
20008122e43SStefano Zampini           } else if (B_ierr <= B_N) {
20108122e43SStefano Zampini             SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr);
20208122e43SStefano Zampini           } else {
2039552c7c7SStefano 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);
20408122e43SStefano Zampini           }
20508122e43SStefano Zampini         }
20608122e43SStefano Zampini 
20708122e43SStefano Zampini         if (B_neigs > nmax) {
208fd14bc51SStefano Zampini           if (pcbddc->dbg_flag) {
209fd14bc51SStefano Zampini             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %d.\n",B_neigs,nmax);
210fd14bc51SStefano Zampini           }
21108122e43SStefano Zampini           B_neigs = nmax;
21208122e43SStefano Zampini         }
21308122e43SStefano Zampini 
2149552c7c7SStefano Zampini         nmin_s = PetscMin(nmin,B_N);
2159552c7c7SStefano Zampini         if (B_neigs < nmin_s) {
21608122e43SStefano Zampini           PetscBLASInt B_neigs2;
21708122e43SStefano Zampini 
21808122e43SStefano Zampini           B_IL = B_neigs + 1;
2199552c7c7SStefano Zampini           ierr = PetscBLASIntCast(nmin_s,&B_IU);CHKERRQ(ierr);
220fd14bc51SStefano Zampini           if (pcbddc->dbg_flag) {
221fd14bc51SStefano 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);
222fd14bc51SStefano Zampini           }
2239ab7bb16SStefano Zampini           if (sub_schurs->is_hermitian) {
22408122e43SStefano Zampini             PetscInt j;
22508122e43SStefano Zampini             for (j=0;j<subset_size;j++) {
22608122e43SStefano Zampini               ierr = PetscMemcpy(S+j*(subset_size+1),Sarray+cumarray+j*(subset_size+1),(subset_size-j)*sizeof(PetscScalar));CHKERRQ(ierr);
22708122e43SStefano Zampini             }
22808122e43SStefano Zampini             for (j=0;j<subset_size;j++) {
22908122e43SStefano Zampini               ierr = PetscMemcpy(St+j*(subset_size+1),Starray+cumarray+j*(subset_size+1),(subset_size-j)*sizeof(PetscScalar));CHKERRQ(ierr);
23008122e43SStefano Zampini             }
23108122e43SStefano Zampini           } else {
23208122e43SStefano Zampini             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
23308122e43SStefano Zampini             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
23408122e43SStefano Zampini           }
23508122e43SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
23608122e43SStefano Zampini #if defined(PETSC_USE_COMPLEX)
23708122e43SStefano Zampini           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&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));
23808122e43SStefano Zampini #else
23908122e43SStefano Zampini           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&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));
24008122e43SStefano Zampini #endif
24108122e43SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
24208122e43SStefano Zampini           B_neigs += B_neigs2;
24308122e43SStefano Zampini         }
24408122e43SStefano Zampini         if (B_ierr) {
24508122e43SStefano Zampini           if (B_ierr < 0 ) {
24608122e43SStefano Zampini             SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
24708122e43SStefano Zampini           } else if (B_ierr <= B_N) {
24808122e43SStefano Zampini             SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr);
24908122e43SStefano Zampini           } else {
2509552c7c7SStefano 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);
25108122e43SStefano Zampini           }
25208122e43SStefano Zampini         }
253fd14bc51SStefano Zampini         if (pcbddc->dbg_flag) {
254fd14bc51SStefano Zampini           PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);
25508122e43SStefano Zampini           for (j=0;j<B_neigs;j++) {
25608122e43SStefano Zampini             if (eigs[j] == 0.0) {
257fd14bc51SStefano Zampini               PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");
25808122e43SStefano Zampini             } else {
259fd14bc51SStefano Zampini               PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1.0/eigs[j]);
260fd14bc51SStefano Zampini             }
26108122e43SStefano Zampini           }
26208122e43SStefano Zampini         }
26308122e43SStefano Zampini       } else {
26408122e43SStefano Zampini           /* TODO */
26508122e43SStefano Zampini       }
26608122e43SStefano Zampini 
26708122e43SStefano Zampini       ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
2688bec7fa6SStefano Zampini       if (B_neigs) {
2694c6709b3SStefano Zampini         PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&B_N,&B_neigs,&B_N,&one,Smult,&B_N,eigv,&B_N,&scalar_zero,Seigv,&B_N));
2708bec7fa6SStefano Zampini       }
2718bec7fa6SStefano Zampini       maxneigs = PetscMax(B_neigs,maxneigs);
2728bec7fa6SStefano Zampini       pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
27308122e43SStefano Zampini       ierr = PetscMemcpy(pcbddc->adaptive_constraints_data+cum2,Seigv,B_neigs*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
274fd14bc51SStefano Zampini 
275fd14bc51SStefano Zampini       if (pcbddc->dbg_flag > 1) {
2769552c7c7SStefano Zampini         PetscInt ii;
2779552c7c7SStefano Zampini         for (ii=0;ii<B_neigs;ii++) {
278fd14bc51SStefano Zampini           PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);
2799552c7c7SStefano Zampini           for (j=0;j<B_N;j++) {
280fd14bc51SStefano Zampini             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e %1.4e\n",eigv[ii*B_N+j],Seigv[ii*B_N+j]);
2819552c7c7SStefano Zampini           }
2829552c7c7SStefano Zampini         }
283fd14bc51SStefano Zampini       }
28408122e43SStefano Zampini       for (j=0;j<B_neigs;j++) {
28508122e43SStefano Zampini #if 0
28608122e43SStefano Zampini         {
28708122e43SStefano Zampini           PetscBLASInt Blas_N,Blas_one = 1.0;
28808122e43SStefano Zampini           PetscScalar norm;
28908122e43SStefano Zampini           ierr = PetscBLASIntCast(subset_size,&Blas_N);CHKERRQ(ierr);
29008122e43SStefano Zampini           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,pcbddc->adaptive_constraints_data+cum2,&Blas_one,pcbddc->adaptive_constraints_data+cum2,&Blas_one));
29108122e43SStefano Zampini           if (pcbddc->adaptive_constraints_data[cum2] > 0.0) {
29208122e43SStefano Zampini             norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
29308122e43SStefano Zampini           } else {
29408122e43SStefano Zampini             norm = -1.0/PetscSqrtReal(PetscRealPart(norm));
29508122e43SStefano Zampini           }
29608122e43SStefano Zampini           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,pcbddc->adaptive_constraints_data+cum2,&Blas_one));
297b1b3d7a2SStefano Zampini         }
298b1b3d7a2SStefano Zampini #endif
29908122e43SStefano Zampini         ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+cum2,idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
30008122e43SStefano Zampini         pcbddc->adaptive_constraints_ptrs[cum++] = cum2;
30108122e43SStefano Zampini         cum2 += subset_size;
30208122e43SStefano Zampini       }
30308122e43SStefano Zampini       ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
30408122e43SStefano Zampini     }
30508122e43SStefano Zampini     /* shift for next computation */
30608122e43SStefano Zampini     cumarray += subset_size*subset_size;
30708122e43SStefano Zampini   }
308fd14bc51SStefano Zampini   if (pcbddc->dbg_flag) {
309fd14bc51SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
310fd14bc51SStefano Zampini   }
31108122e43SStefano Zampini   pcbddc->adaptive_constraints_ptrs[cum] = cum2;
31208122e43SStefano Zampini   ierr = PetscFree2(Smult,Seigv);CHKERRQ(ierr);
31308122e43SStefano Zampini 
31408122e43SStefano Zampini   if (mss) {
31508122e43SStefano Zampini     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
31608122e43SStefano Zampini     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
31708122e43SStefano Zampini   }
31808122e43SStefano Zampini   ierr = PetscFree7(S,St,eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
31908122e43SStefano Zampini #if defined(PETSC_USE_COMPLEX)
32008122e43SStefano Zampini   ierr = PetscFree(rwork);CHKERRQ(ierr);
32108122e43SStefano Zampini #endif
32208122e43SStefano Zampini   if (pcbddc->dbg_flag) {
3231b968477SStefano Zampini     PetscInt maxneigs_r;
32408122e43SStefano Zampini     ierr = MPI_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
32508122e43SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Maximum number of constraints per cc %d\n",maxneigs_r);CHKERRQ(ierr);
32608122e43SStefano Zampini   }
32708122e43SStefano Zampini   PetscFunctionReturn(0);
32808122e43SStefano Zampini }
329b1b3d7a2SStefano Zampini 
330674ae819SStefano Zampini #undef __FUNCT__
331c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpSolvers"
332c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpSolvers(PC pc)
333c8587f34SStefano Zampini {
334c8587f34SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3358629588bSStefano Zampini   PetscScalar    *coarse_submat_vals;
336c8587f34SStefano Zampini   PetscErrorCode ierr;
337c8587f34SStefano Zampini 
338c8587f34SStefano Zampini   PetscFunctionBegin;
339f4ddd8eeSStefano Zampini   /* Setup local scatters R_to_B and (optionally) R_to_D */
3405e8657edSStefano Zampini   /* PCBDDCSetUpLocalWorkVectors should be called first! */
341c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
342c8587f34SStefano Zampini 
343684f6988SStefano Zampini   /* Setup local neumann solver ksp_R */
3440fccc4e9SStefano Zampini   /* PCBDDCSetUpLocalScatters should be called first! */
345684f6988SStefano Zampini   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
346c8587f34SStefano Zampini 
347c8587f34SStefano Zampini   /* Change global null space passed in by the user if change of basis has been requested */
348b9b85e73SStefano Zampini   if (pcbddc->NullSpace && pcbddc->ChangeOfBasisMatrix) {
349c8587f34SStefano Zampini     ierr = PCBDDCNullSpaceAdaptGlobal(pc);CHKERRQ(ierr);
350c8587f34SStefano Zampini   }
351c8587f34SStefano Zampini 
3528629588bSStefano Zampini   /*
3538629588bSStefano Zampini      Setup local correction and local part of coarse basis.
3548629588bSStefano Zampini      Gives back the dense local part of the coarse matrix in column major ordering
3558629588bSStefano Zampini   */
35647f4ddc3SStefano Zampini   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3578629588bSStefano Zampini 
3588629588bSStefano Zampini   /* Compute total number of coarse nodes and setup coarse solver */
3598629588bSStefano Zampini   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3608629588bSStefano Zampini 
3618629588bSStefano Zampini   /* free */
3628629588bSStefano Zampini   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
363c8587f34SStefano Zampini   PetscFunctionReturn(0);
364c8587f34SStefano Zampini }
365c8587f34SStefano Zampini 
366c8587f34SStefano Zampini #undef __FUNCT__
367674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetCustomization"
368674ae819SStefano Zampini PetscErrorCode PCBDDCResetCustomization(PC pc)
369674ae819SStefano Zampini {
370674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
371674ae819SStefano Zampini   PetscErrorCode ierr;
372674ae819SStefano Zampini 
373674ae819SStefano Zampini   PetscFunctionBegin;
374674ae819SStefano Zampini   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
375674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
376674ae819SStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->NullSpace);CHKERRQ(ierr);
377674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
378785d1243SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
379674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
380f4ddd8eeSStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
381f4ddd8eeSStefano Zampini   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
382785d1243SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
38363602bcaSStefano Zampini   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
38463602bcaSStefano Zampini   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
385674ae819SStefano Zampini   PetscFunctionReturn(0);
386674ae819SStefano Zampini }
387674ae819SStefano Zampini 
388674ae819SStefano Zampini #undef __FUNCT__
389674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetTopography"
390674ae819SStefano Zampini PetscErrorCode PCBDDCResetTopography(PC pc)
391674ae819SStefano Zampini {
392674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
393674ae819SStefano Zampini   PetscErrorCode ierr;
394674ae819SStefano Zampini 
395674ae819SStefano Zampini   PetscFunctionBegin;
396b9b85e73SStefano Zampini   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
397674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
398674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
399674ae819SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
400b96c3477SStefano Zampini   ierr = PCBDDCSubSchursReset(pcbddc->sub_schurs);CHKERRQ(ierr);
401674ae819SStefano Zampini   PetscFunctionReturn(0);
402674ae819SStefano Zampini }
403674ae819SStefano Zampini 
404674ae819SStefano Zampini #undef __FUNCT__
405674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetSolvers"
406674ae819SStefano Zampini PetscErrorCode PCBDDCResetSolvers(PC pc)
407674ae819SStefano Zampini {
408674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
40906656605SStefano Zampini   PetscScalar    *array;
410674ae819SStefano Zampini   PetscErrorCode ierr;
411674ae819SStefano Zampini 
412674ae819SStefano Zampini   PetscFunctionBegin;
413674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
41458da7f69SStefano Zampini   if (pcbddc->coarse_phi_B) {
41506656605SStefano Zampini     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
41606656605SStefano Zampini     ierr = PetscFree(array);CHKERRQ(ierr);
41758da7f69SStefano Zampini   }
418674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
419674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
42015aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
42115aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
422674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
423674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
42406656605SStefano Zampini   if (pcbddc->local_auxmat2) {
42506656605SStefano Zampini     ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
42606656605SStefano Zampini     ierr = PetscFree(array);CHKERRQ(ierr);
42706656605SStefano Zampini   }
428674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
42906656605SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
430674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
431674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
4328ce42a96SStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
433674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
434674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
435674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
436f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->ksp_D);CHKERRQ(ierr);
437f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->ksp_R);CHKERRQ(ierr);
438f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
439f4ddd8eeSStefano Zampini   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
440727cdba6SStefano Zampini   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
441f4ddd8eeSStefano Zampini   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
44270cf5478SStefano Zampini   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
4436e683305SStefano Zampini   ierr = ISDestroy(&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
444674ae819SStefano Zampini   PetscFunctionReturn(0);
445674ae819SStefano Zampini }
446674ae819SStefano Zampini 
447674ae819SStefano Zampini #undef __FUNCT__
448f4ddd8eeSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalWorkVectors"
449f4ddd8eeSStefano Zampini PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
4506bfb1811SStefano Zampini {
4516bfb1811SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
4526bfb1811SStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
4536bfb1811SStefano Zampini   VecType        impVecType;
454e9189074SStefano Zampini   PetscInt       n_constraints,n_R,old_size;
4556bfb1811SStefano Zampini   PetscErrorCode ierr;
4566bfb1811SStefano Zampini 
4576bfb1811SStefano Zampini   PetscFunctionBegin;
458f4ddd8eeSStefano Zampini   if (!pcbddc->ConstraintMatrix) {
459f4ddd8eeSStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Constraint matrix has not been created");
460f4ddd8eeSStefano Zampini   }
461e7b262bdSStefano Zampini   /* get sizes */
462e9189074SStefano Zampini   n_constraints = pcbddc->local_primal_size - pcbddc->n_actual_vertices;
463e9189074SStefano Zampini   n_R = pcis->n-pcbddc->n_actual_vertices;
4646bfb1811SStefano Zampini   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
465e7b262bdSStefano Zampini   /* local work vectors (try to avoid unneeded work)*/
466e7b262bdSStefano Zampini   /* R nodes */
467e7b262bdSStefano Zampini   old_size = -1;
468e7b262bdSStefano Zampini   if (pcbddc->vec1_R) {
469e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
470e7b262bdSStefano Zampini   }
471e7b262bdSStefano Zampini   if (n_R != old_size) {
472e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
473e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
4746bfb1811SStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
4756bfb1811SStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
4766bfb1811SStefano Zampini     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
4776bfb1811SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
478e7b262bdSStefano Zampini   }
479e7b262bdSStefano Zampini   /* local primal dofs */
480e7b262bdSStefano Zampini   old_size = -1;
481e7b262bdSStefano Zampini   if (pcbddc->vec1_P) {
482e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
483e7b262bdSStefano Zampini   }
484e9189074SStefano Zampini   if (pcbddc->local_primal_size != old_size) {
485e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
48683b7ccabSStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
487e9189074SStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
4886bfb1811SStefano Zampini     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
489e7b262bdSStefano Zampini   }
490e7b262bdSStefano Zampini   /* local explicit constraints */
491e7b262bdSStefano Zampini   old_size = -1;
492e7b262bdSStefano Zampini   if (pcbddc->vec1_C) {
493e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
494e7b262bdSStefano Zampini   }
495e7b262bdSStefano Zampini   if (n_constraints && n_constraints != old_size) {
496e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
49783b7ccabSStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
49883b7ccabSStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
49983b7ccabSStefano Zampini     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
50083b7ccabSStefano Zampini   }
5016bfb1811SStefano Zampini   PetscFunctionReturn(0);
5026bfb1811SStefano Zampini }
5036bfb1811SStefano Zampini 
5046bfb1811SStefano Zampini #undef __FUNCT__
50547f4ddc3SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCorrection"
50647f4ddc3SStefano Zampini PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
50788ebb749SStefano Zampini {
50825084f0cSStefano Zampini   PetscErrorCode         ierr;
50925084f0cSStefano Zampini   /* pointers to pcis and pcbddc */
51088ebb749SStefano Zampini   PC_IS*                 pcis = (PC_IS*)pc->data;
51188ebb749SStefano Zampini   PC_BDDC*               pcbddc = (PC_BDDC*)pc->data;
51225084f0cSStefano Zampini   /* submatrices of local problem */
51388ebb749SStefano Zampini   Mat                    A_RV,A_VR,A_VV;
51406656605SStefano Zampini   /* submatrices of local coarse problem */
51506656605SStefano Zampini   Mat                    S_VV,S_CV,S_VC,S_CC;
51625084f0cSStefano Zampini   /* working matrices */
51706656605SStefano Zampini   Mat                    C_CR;
51825084f0cSStefano Zampini   /* additional working stuff */
51906656605SStefano Zampini   PC                     pc_R;
52006656605SStefano Zampini   Mat                    F;
52106656605SStefano Zampini   PetscBool              isLU,isCHOL,isILU;
52206656605SStefano Zampini 
52325084f0cSStefano Zampini   PetscScalar            *coarse_submat_vals; /* TODO: use a PETSc matrix */
52406656605SStefano Zampini   PetscScalar            *work;
52506656605SStefano Zampini   PetscInt               *idx_V_B;
52606656605SStefano Zampini   PetscInt               n,n_vertices,n_constraints;
52706656605SStefano Zampini   PetscInt               i,n_R,n_D,n_B;
528b9d89cd5SStefano Zampini   PetscBool              unsymmetric_check;
52945a1bb75SStefano Zampini   /* matrix type (vector type propagated downstream from vec1_C and local matrix type) */
53088ebb749SStefano Zampini   MatType                impMatType;
53125084f0cSStefano Zampini   /* some shortcuts to scalars */
53206656605SStefano Zampini   PetscScalar            one=1.0,m_one=-1.0;
53388ebb749SStefano Zampini 
53488ebb749SStefano Zampini   PetscFunctionBegin;
535e9189074SStefano Zampini   /* get number of vertices (corners plus constraints with change of basis)
536e9189074SStefano Zampini      pcbddc->n_actual_vertices stores the actual number of vertices, pcbddc->n_vertices the number of corners computed */
537e9189074SStefano Zampini   n_vertices = pcbddc->n_actual_vertices;
53888ebb749SStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
53988ebb749SStefano Zampini   /* Set Non-overlapping dimensions */
54088ebb749SStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
54188ebb749SStefano Zampini   n_R = pcis->n-n_vertices;
54288ebb749SStefano Zampini 
54388ebb749SStefano Zampini   /* Set types for local objects needed by BDDC precondtioner */
54488ebb749SStefano Zampini   impMatType = MATSEQDENSE;
54588ebb749SStefano Zampini 
54688ebb749SStefano Zampini   /* vertices in boundary numbering */
547785e854fSJed Brown   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
5485e8657edSStefano Zampini   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->primal_indices_local_idxs,&i,idx_V_B);CHKERRQ(ierr);
54988ebb749SStefano Zampini   if (i != n_vertices) {
55022d5777bSStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %d != %d\n",n_vertices,i);
55188ebb749SStefano Zampini   }
55288ebb749SStefano Zampini 
55306656605SStefano Zampini   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
55406656605SStefano Zampini   ierr = PetscMalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
55506656605SStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
55606656605SStefano Zampini   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
55706656605SStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
55806656605SStefano Zampini   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
55906656605SStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
56006656605SStefano Zampini   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
56106656605SStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
56206656605SStefano Zampini   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
56306656605SStefano Zampini 
56406656605SStefano Zampini   unsymmetric_check = PETSC_FALSE;
56506656605SStefano Zampini   /* allocate workspace */
56606656605SStefano Zampini   n = 0;
56706656605SStefano Zampini   if (n_constraints) {
56806656605SStefano Zampini     n += n_R*n_constraints;
56906656605SStefano Zampini   }
57006656605SStefano Zampini   if (n_vertices) {
57106656605SStefano Zampini     n = PetscMax(2*n_R*n_vertices,n);
57206656605SStefano Zampini   }
57306656605SStefano Zampini   if (!pcbddc->issym) {
57406656605SStefano Zampini     n = PetscMax(2*n_R*pcbddc->local_primal_size,n);
57506656605SStefano Zampini     unsymmetric_check = PETSC_TRUE;
57606656605SStefano Zampini   }
57706656605SStefano Zampini   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
57806656605SStefano Zampini 
57906656605SStefano Zampini   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
58006656605SStefano Zampini   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
58106656605SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
58206656605SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
58306656605SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
58406656605SStefano Zampini   if (isLU || isILU || isCHOL) {
58506656605SStefano Zampini     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
58606656605SStefano Zampini   } else {
58706656605SStefano Zampini     F = NULL;
58806656605SStefano Zampini   }
58906656605SStefano Zampini 
59088ebb749SStefano Zampini   /* Precompute stuffs needed for preprocessing and application of BDDC*/
59188ebb749SStefano Zampini   if (n_constraints) {
59206656605SStefano Zampini     Mat M1,M2,M3;
59306656605SStefano Zampini     IS  is_aux;
594f4ddd8eeSStefano Zampini     /* see if we can save some allocations */
595f4ddd8eeSStefano Zampini     if (pcbddc->local_auxmat2) {
596f4ddd8eeSStefano Zampini       PetscInt on_R,on_constraints;
597f4ddd8eeSStefano Zampini       ierr = MatGetSize(pcbddc->local_auxmat2,&on_R,&on_constraints);CHKERRQ(ierr);
598f4ddd8eeSStefano Zampini       if (on_R != n_R || on_constraints != n_constraints) {
59906656605SStefano Zampini         PetscScalar *marray;
60006656605SStefano Zampini 
60106656605SStefano Zampini         ierr = MatDenseGetArray(pcbddc->local_auxmat2,&marray);CHKERRQ(ierr);
60206656605SStefano Zampini         ierr = PetscFree(marray);CHKERRQ(ierr);
603f4ddd8eeSStefano Zampini         ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
604f4ddd8eeSStefano Zampini         ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
605f4ddd8eeSStefano Zampini       }
606f4ddd8eeSStefano Zampini     }
60745a1bb75SStefano Zampini     /* auxiliary matrices */
608f4ddd8eeSStefano Zampini     if (!pcbddc->local_auxmat2) {
60906656605SStefano Zampini       PetscScalar *marray;
61006656605SStefano Zampini 
61106656605SStefano Zampini       ierr = PetscMalloc1(2*n_R*n_constraints,&marray);CHKERRQ(ierr);
61206656605SStefano Zampini       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,marray,&pcbddc->local_auxmat2);CHKERRQ(ierr);
61306656605SStefano Zampini       marray += n_R*n_constraints;
61406656605SStefano Zampini       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_R,marray,&pcbddc->local_auxmat1);CHKERRQ(ierr);
615f4ddd8eeSStefano Zampini     }
61688ebb749SStefano Zampini 
61725084f0cSStefano Zampini     /* Extract constraints on R nodes: C_{CR}  */
61825084f0cSStefano Zampini     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
6198ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
62025084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
62188ebb749SStefano Zampini 
62288ebb749SStefano Zampini     /* Assemble local_auxmat2 = - A_{RR}^{-1} C^T_{CR} needed by BDDC application */
62306656605SStefano Zampini     ierr = PetscMemzero(work,n_R*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
62488ebb749SStefano Zampini     for (i=0;i<n_constraints;i++) {
62506656605SStefano Zampini       const PetscScalar *row_cmat_values;
62606656605SStefano Zampini       const PetscInt    *row_cmat_indices;
62706656605SStefano Zampini       PetscInt          size_of_constraint,j;
62888ebb749SStefano Zampini 
62906656605SStefano Zampini       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
63006656605SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
63106656605SStefano Zampini         work[row_cmat_indices[j]+i*n_R] = -row_cmat_values[j];
63206656605SStefano Zampini       }
63306656605SStefano Zampini       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
63406656605SStefano Zampini     }
63506656605SStefano Zampini     if (F) {
63606656605SStefano Zampini       Mat B;
63706656605SStefano Zampini 
63806656605SStefano Zampini       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
63906656605SStefano Zampini       ierr = MatMatSolve(F,B,pcbddc->local_auxmat2);CHKERRQ(ierr);
64006656605SStefano Zampini       ierr = MatDestroy(&B);CHKERRQ(ierr);
64106656605SStefano Zampini     } else {
64206656605SStefano Zampini       PetscScalar *xarray;
64306656605SStefano Zampini       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&xarray);CHKERRQ(ierr);
64406656605SStefano Zampini       for (i=0;i<n_constraints;i++) {
64506656605SStefano Zampini         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
64606656605SStefano Zampini         ierr = VecPlaceArray(pcbddc->vec2_R,xarray+i*n_R);CHKERRQ(ierr);
64706656605SStefano Zampini         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
64806656605SStefano Zampini         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
64906656605SStefano Zampini         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
65006656605SStefano Zampini       }
65106656605SStefano Zampini       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&xarray);CHKERRQ(ierr);
65206656605SStefano Zampini     }
65306656605SStefano Zampini 
65406656605SStefano Zampini     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
65506656605SStefano Zampini     ierr = MatConvert(C_CR,impMatType,MAT_REUSE_MATRIX,&C_CR);CHKERRQ(ierr);
65625084f0cSStefano Zampini     ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
65706656605SStefano Zampini     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M1);CHKERRQ(ierr);
65806656605SStefano Zampini     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
65925084f0cSStefano Zampini     ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
66006656605SStefano Zampini     ierr = VecSet(pcbddc->vec1_C,m_one);CHKERRQ(ierr);
66106656605SStefano Zampini     ierr = MatDiagonalSet(M2,pcbddc->vec1_C,INSERT_VALUES);CHKERRQ(ierr);
66225084f0cSStefano Zampini     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
66325084f0cSStefano Zampini     ierr = MatDestroy(&M2);CHKERRQ(ierr);
66425084f0cSStefano Zampini     ierr = MatDestroy(&M3);CHKERRQ(ierr);
66506656605SStefano Zampini     /* Assemble local_auxmat1 = S_CC*C_{CR} needed by BDDC application in KSP and in preproc */
666f4ddd8eeSStefano Zampini     ierr = MatMatMult(M1,C_CR,MAT_REUSE_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
66706656605SStefano Zampini     ierr = MatCopy(M1,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
66806656605SStefano Zampini     ierr = MatDestroy(&M1);CHKERRQ(ierr);
66988ebb749SStefano Zampini   }
67088ebb749SStefano Zampini   /* Get submatrices from subdomain matrix */
67188ebb749SStefano Zampini   if (n_vertices) {
67206656605SStefano Zampini     Mat       newmat;
67306656605SStefano Zampini     IS        is_aux;
6743a50541eSStefano Zampini     PetscInt  ibs,mbs;
6753a50541eSStefano Zampini     PetscBool issbaij;
6763a50541eSStefano Zampini 
6773a50541eSStefano Zampini     ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
6789577ea80SStefano Zampini     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
6799577ea80SStefano Zampini     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
6803a50541eSStefano Zampini     if (ibs != mbs) { /* need to convert to SEQAIJ */
6819577ea80SStefano Zampini       ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
6829577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
6839577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
6849577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
6859577ea80SStefano Zampini       ierr = MatDestroy(&newmat);CHKERRQ(ierr);
6869577ea80SStefano Zampini     } else {
6873a50541eSStefano Zampini       /* this is safe */
6889577ea80SStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
6893a50541eSStefano Zampini       ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
6903a50541eSStefano Zampini       if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
6913a50541eSStefano Zampini         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
6923a50541eSStefano Zampini         ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
69306656605SStefano Zampini         ierr = MatTranspose(A_VR,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
6943a50541eSStefano Zampini         ierr = MatDestroy(&newmat);CHKERRQ(ierr);
69503af80d8SStefano Zampini         ierr = MatConvert(A_VV,MATSEQBAIJ,MAT_REUSE_MATRIX,&A_VV);CHKERRQ(ierr);
6963a50541eSStefano Zampini       } else {
6979577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
6989577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
6999577ea80SStefano Zampini       }
7003a50541eSStefano Zampini     }
70125084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
70288ebb749SStefano Zampini   }
70388ebb749SStefano Zampini 
70488ebb749SStefano Zampini   /* Matrix of coarse basis functions (local) */
705f4ddd8eeSStefano Zampini   if (pcbddc->coarse_phi_B) {
70606656605SStefano Zampini     PetscInt on_B,on_primal,on_D=n_D;
70706656605SStefano Zampini     if (pcbddc->coarse_phi_D) {
70806656605SStefano Zampini       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
70906656605SStefano Zampini     }
710f4ddd8eeSStefano Zampini     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
71106656605SStefano Zampini     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
71206656605SStefano Zampini       PetscScalar *marray;
71306656605SStefano Zampini 
71406656605SStefano Zampini       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
71506656605SStefano Zampini       ierr = PetscFree(marray);CHKERRQ(ierr);
716f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
717f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
718f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
719f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
720f4ddd8eeSStefano Zampini     }
721f4ddd8eeSStefano Zampini   }
72206656605SStefano Zampini 
723f4ddd8eeSStefano Zampini   if (!pcbddc->coarse_phi_B) {
72406656605SStefano Zampini     PetscScalar *marray;
72588ebb749SStefano Zampini 
72606656605SStefano Zampini     n = n_B*pcbddc->local_primal_size;
7278eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
72806656605SStefano Zampini       n += n_D*pcbddc->local_primal_size;
72988ebb749SStefano Zampini     }
730b9d89cd5SStefano Zampini     if (!pcbddc->issym) {
73106656605SStefano Zampini       n *= 2;
732f4ddd8eeSStefano Zampini     }
73306656605SStefano Zampini     ierr = PetscCalloc1(n,&marray);CHKERRQ(ierr);
73406656605SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marray,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
73506656605SStefano Zampini     n = n_B*pcbddc->local_primal_size;
73606656605SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
73706656605SStefano Zampini       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
73806656605SStefano Zampini       n += n_D*pcbddc->local_primal_size;
73988ebb749SStefano Zampini     }
74006656605SStefano Zampini     if (!pcbddc->issym) {
74106656605SStefano Zampini       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
7421b968477SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
74306656605SStefano Zampini         n = n_B*pcbddc->local_primal_size;
74406656605SStefano Zampini         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
74588ebb749SStefano Zampini       }
74688ebb749SStefano Zampini     } else {
747c0553b1fSStefano Zampini       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
748c0553b1fSStefano Zampini       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
7491b968477SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
750c0553b1fSStefano Zampini         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
751c0553b1fSStefano Zampini         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
752c0553b1fSStefano Zampini       }
75388ebb749SStefano Zampini     }
75406656605SStefano Zampini   }
75506656605SStefano Zampini   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
75606656605SStefano Zampini   /* vertices */
75706656605SStefano Zampini   if (n_vertices) {
75816f15bc4SStefano Zampini 
75916f15bc4SStefano Zampini     if (n_R) {
76006656605SStefano Zampini       Mat          A_RRmA_RV,S_VVt; /* S_VVt with LDA=N */
76106656605SStefano Zampini       PetscBLASInt B_N,B_one = 1;
76216f15bc4SStefano Zampini       PetscScalar  *x,*y;
76306656605SStefano Zampini 
76406656605SStefano Zampini       ierr = PetscMemzero(work,2*n_R*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
76506656605SStefano Zampini       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
76606656605SStefano Zampini       ierr = MatConvert(A_RV,impMatType,MAT_REUSE_MATRIX,&A_RV);CHKERRQ(ierr);
76706656605SStefano Zampini       if (F) {
76806656605SStefano Zampini         ierr = MatMatSolve(F,A_RV,A_RRmA_RV);CHKERRQ(ierr);
76906656605SStefano Zampini       } else {
77006656605SStefano Zampini         ierr = MatDenseGetArray(A_RV,&y);CHKERRQ(ierr);
77106656605SStefano Zampini         for (i=0;i<n_vertices;i++) {
77206656605SStefano Zampini           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*n_R);CHKERRQ(ierr);
77306656605SStefano Zampini           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
77406656605SStefano Zampini           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
77506656605SStefano Zampini           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
77606656605SStefano Zampini           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
77706656605SStefano Zampini         }
77806656605SStefano Zampini         ierr = MatDenseRestoreArray(A_RV,&y);CHKERRQ(ierr);
77906656605SStefano Zampini       }
78006656605SStefano Zampini       ierr = MatScale(A_RRmA_RV,m_one);CHKERRQ(ierr);
78106656605SStefano Zampini       /* S_VV and S_CV are the subdomain contribution to coarse matrix. WARNING -> column major ordering */
78206656605SStefano Zampini       if (n_constraints) {
78306656605SStefano Zampini         Mat B;
78406656605SStefano Zampini         ierr = MatMatMult(pcbddc->local_auxmat1,A_RRmA_RV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
78506656605SStefano Zampini         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work+n_R*n_vertices,&B);CHKERRQ(ierr);
78606656605SStefano Zampini         ierr = MatMatMult(pcbddc->local_auxmat2,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
78706656605SStefano Zampini         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
78806656605SStefano Zampini         ierr = PetscBLASIntCast(n_R*n_vertices,&B_N);CHKERRQ(ierr);
78906656605SStefano Zampini         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+n_R*n_vertices,&B_one,work,&B_one));
79006656605SStefano Zampini         ierr = MatDestroy(&B);CHKERRQ(ierr);
79106656605SStefano Zampini       }
79206656605SStefano Zampini       ierr = MatConvert(A_VR,impMatType,MAT_REUSE_MATRIX,&A_VR);CHKERRQ(ierr);
79306656605SStefano Zampini       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
79406656605SStefano Zampini       ierr = MatConvert(A_VV,impMatType,MAT_REUSE_MATRIX,&A_VV);CHKERRQ(ierr);
79506656605SStefano Zampini       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
79606656605SStefano Zampini       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
79706656605SStefano Zampini       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
79806656605SStefano Zampini       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
79906656605SStefano Zampini       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
80006656605SStefano Zampini       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
80106656605SStefano Zampini       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
80206656605SStefano Zampini       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
80316f15bc4SStefano Zampini       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
80416f15bc4SStefano Zampini     } else {
80516f15bc4SStefano Zampini       ierr = MatConvert(A_VV,impMatType,MAT_REUSE_MATRIX,&A_VV);CHKERRQ(ierr);
80616f15bc4SStefano Zampini       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
80716f15bc4SStefano Zampini     }
80806656605SStefano Zampini     /* coarse basis functions */
80906656605SStefano Zampini     for (i=0;i<n_vertices;i++) {
81016f15bc4SStefano Zampini       PetscScalar *y;
81116f15bc4SStefano Zampini 
81206656605SStefano Zampini       ierr = VecPlaceArray(pcbddc->vec1_R,work+n_R*i);CHKERRQ(ierr);
81306656605SStefano Zampini       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
81406656605SStefano Zampini       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
81506656605SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
81606656605SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
81706656605SStefano Zampini       y[n_B*i+idx_V_B[i]] = 1.0;
81806656605SStefano Zampini       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
81906656605SStefano Zampini       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
82006656605SStefano Zampini 
82106656605SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
82206656605SStefano Zampini         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
82306656605SStefano Zampini         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
82406656605SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
82506656605SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
82606656605SStefano Zampini         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
82706656605SStefano Zampini         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
82806656605SStefano Zampini       }
82906656605SStefano Zampini       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
83006656605SStefano Zampini     }
83116f15bc4SStefano Zampini     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
83206656605SStefano Zampini     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
83306656605SStefano Zampini   }
83406656605SStefano Zampini 
83506656605SStefano Zampini   if (n_constraints) {
83606656605SStefano Zampini     Mat B;
83706656605SStefano Zampini 
83806656605SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
83906656605SStefano Zampini     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
84006656605SStefano Zampini     ierr = MatMatMult(pcbddc->local_auxmat2,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
84106656605SStefano Zampini     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
84206656605SStefano Zampini     if (n_vertices) {
84306656605SStefano Zampini       ierr = MatMatMult(A_VR,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_VC);CHKERRQ(ierr);
84406656605SStefano Zampini     }
84506656605SStefano Zampini     ierr = MatDestroy(&B);CHKERRQ(ierr);
84606656605SStefano Zampini     /* coarse basis functions */
84706656605SStefano Zampini     for (i=0;i<n_constraints;i++) {
84806656605SStefano Zampini       PetscScalar *y;
84906656605SStefano Zampini 
85006656605SStefano Zampini       ierr = VecPlaceArray(pcbddc->vec1_R,work+n_R*i);CHKERRQ(ierr);
85106656605SStefano Zampini       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
85206656605SStefano Zampini       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
85306656605SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
85406656605SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
85506656605SStefano Zampini       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
85606656605SStefano Zampini       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
85706656605SStefano Zampini 
85806656605SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
85906656605SStefano Zampini         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
86006656605SStefano Zampini         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
86106656605SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
86206656605SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
86306656605SStefano Zampini         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
86406656605SStefano Zampini         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
86506656605SStefano Zampini       }
86606656605SStefano Zampini       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
86706656605SStefano Zampini     }
86806656605SStefano Zampini   }
86906656605SStefano Zampini 
87006656605SStefano Zampini   /* compute other basis functions for non-symmetric problems */
87106656605SStefano Zampini   if (!pcbddc->issym) {
87206656605SStefano Zampini     Mat B,X;
87306656605SStefano Zampini 
87406656605SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,pcbddc->local_primal_size,work,&B);CHKERRQ(ierr);
87506656605SStefano Zampini 
87606656605SStefano Zampini     if (n_constraints) {
87716f15bc4SStefano Zampini       Mat S_CCT,B_C;
87806656605SStefano Zampini 
87906656605SStefano Zampini       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work+n_vertices*n_R,&B_C);CHKERRQ(ierr);
88006656605SStefano Zampini       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
88106656605SStefano Zampini       ierr = MatTransposeMatMult(C_CR,S_CCT,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
88216f15bc4SStefano Zampini       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
88306656605SStefano Zampini       if (n_vertices) {
88416f15bc4SStefano Zampini         Mat B_V,S_VCT;
88506656605SStefano Zampini 
88606656605SStefano Zampini         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&B_V);CHKERRQ(ierr);
88706656605SStefano Zampini         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
88806656605SStefano Zampini         ierr = MatTransposeMatMult(C_CR,S_VCT,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
88906656605SStefano Zampini         ierr = MatDestroy(&B_V);CHKERRQ(ierr);
89016f15bc4SStefano Zampini         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
89106656605SStefano Zampini       }
89206656605SStefano Zampini       ierr = MatDestroy(&B_C);CHKERRQ(ierr);
89306656605SStefano Zampini     }
89416f15bc4SStefano Zampini     if (n_vertices && n_R) {
89506656605SStefano Zampini       Mat          A_VRT;
89606656605SStefano Zampini       PetscBLASInt B_N,B_one = 1;
89706656605SStefano Zampini 
89806656605SStefano Zampini       if (!n_constraints) { /* if there are no constraints, reset work */
89906656605SStefano Zampini         ierr = PetscMemzero(work,n_R*pcbddc->local_primal_size*sizeof(PetscScalar));CHKERRQ(ierr);
90006656605SStefano Zampini       }
90106656605SStefano Zampini       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work+pcbddc->local_primal_size*n_R,&A_VRT);CHKERRQ(ierr);
90206656605SStefano Zampini       ierr = MatTranspose(A_VR,MAT_REUSE_MATRIX,&A_VRT);CHKERRQ(ierr);
90306656605SStefano Zampini       ierr = PetscBLASIntCast(n_vertices*n_R,&B_N);CHKERRQ(ierr);
90406656605SStefano Zampini       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&m_one,work+pcbddc->local_primal_size*n_R,&B_one,work,&B_one));
90516f15bc4SStefano Zampini       ierr = MatDestroy(&A_VRT);CHKERRQ(ierr);
90606656605SStefano Zampini     }
90706656605SStefano Zampini 
90806656605SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,pcbddc->local_primal_size,work+pcbddc->local_primal_size*n_R,&X);CHKERRQ(ierr);
90906656605SStefano Zampini     if (F) { /* currently there's no support for MatTransposeMatSolve(F,B,X) */
91006656605SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
91106656605SStefano Zampini         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
91206656605SStefano Zampini         ierr = VecPlaceArray(pcbddc->vec2_R,work+(i+pcbddc->local_primal_size)*n_R);CHKERRQ(ierr);
91306656605SStefano Zampini         ierr = MatSolveTranspose(F,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
91406656605SStefano Zampini         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
91506656605SStefano Zampini         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
91606656605SStefano Zampini       }
91706656605SStefano Zampini     } else {
91806656605SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
91906656605SStefano Zampini         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
92006656605SStefano Zampini         ierr = VecPlaceArray(pcbddc->vec2_R,work+(i+pcbddc->local_primal_size)*n_R);CHKERRQ(ierr);
92106656605SStefano Zampini         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
92206656605SStefano Zampini         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
92306656605SStefano Zampini         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
92406656605SStefano Zampini       }
92506656605SStefano Zampini     }
92606656605SStefano Zampini     ierr = MatDestroy(&B);CHKERRQ(ierr);
92706656605SStefano Zampini     /* coarse basis functions */
92806656605SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
92906656605SStefano Zampini       PetscScalar *y;
93006656605SStefano Zampini 
93106656605SStefano Zampini       ierr = VecPlaceArray(pcbddc->vec1_R,work+n_R*(i+pcbddc->local_primal_size));CHKERRQ(ierr);
93206656605SStefano Zampini       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
93306656605SStefano Zampini       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
93406656605SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
93506656605SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
93606656605SStefano Zampini       if (i<n_vertices) {
93706656605SStefano Zampini         y[n_B*i+idx_V_B[i]] = 1.0;
93806656605SStefano Zampini       }
93906656605SStefano Zampini       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
94006656605SStefano Zampini       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
94106656605SStefano Zampini 
94206656605SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
94306656605SStefano Zampini         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
94406656605SStefano Zampini         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
94506656605SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
94606656605SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
94706656605SStefano Zampini         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
94806656605SStefano Zampini         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
94906656605SStefano Zampini       }
95006656605SStefano Zampini       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
95106656605SStefano Zampini     }
95206656605SStefano Zampini     ierr = MatDestroy(&X);CHKERRQ(ierr);
95306656605SStefano Zampini   }
95406656605SStefano Zampini 
95588ebb749SStefano Zampini   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
95606656605SStefano Zampini   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
95706656605SStefano Zampini   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
95806656605SStefano Zampini   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
95906656605SStefano Zampini   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
96088ebb749SStefano Zampini   /* Checking coarse_sub_mat and coarse basis functios */
96188ebb749SStefano Zampini   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
96288ebb749SStefano Zampini   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
96325084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
96488ebb749SStefano Zampini     Mat         coarse_sub_mat;
96525084f0cSStefano Zampini     Mat         AUXMAT,TM1,TM2,TM3,TM4;
96688ebb749SStefano Zampini     Mat         coarse_phi_D,coarse_phi_B;
96788ebb749SStefano Zampini     Mat         coarse_psi_D,coarse_psi_B;
96888ebb749SStefano Zampini     Mat         A_II,A_BB,A_IB,A_BI;
9698bec7fa6SStefano Zampini     Mat         C_B,CPHI;
9708bec7fa6SStefano Zampini     IS          is_dummy;
9718bec7fa6SStefano Zampini     Vec         mones;
97288ebb749SStefano Zampini     MatType     checkmattype=MATSEQAIJ;
97388ebb749SStefano Zampini     PetscReal   real_value;
97488ebb749SStefano Zampini 
97588ebb749SStefano Zampini     ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
97688ebb749SStefano Zampini     ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
97788ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
97888ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
97988ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
98088ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
981c0553b1fSStefano Zampini     if (unsymmetric_check) {
98288ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
98388ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
98488ebb749SStefano Zampini     }
98588ebb749SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
98688ebb749SStefano Zampini 
98725084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
98806656605SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation\n");CHKERRQ(ierr);
98925084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
990c0553b1fSStefano Zampini     if (unsymmetric_check) {
99188ebb749SStefano Zampini       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
99288ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
99388ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
99488ebb749SStefano Zampini       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
99588ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
99688ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
99788ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
99888ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
99988ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
100088ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
100188ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
100288ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
100388ebb749SStefano Zampini     } else {
100488ebb749SStefano Zampini       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
100588ebb749SStefano Zampini       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
100688ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
100788ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
100888ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
100988ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
101088ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
101188ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
101288ebb749SStefano Zampini     }
101388ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
101488ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
101588ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
101688ebb749SStefano Zampini     ierr = MatConvert(TM1,MATSEQDENSE,MAT_REUSE_MATRIX,&TM1);CHKERRQ(ierr);
101781d9aea3SBarry Smith     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
10188bec7fa6SStefano Zampini     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
10190fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
102006656605SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d      matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
10218bec7fa6SStefano Zampini 
10228bec7fa6SStefano Zampini     /* check constraints */
10238bec7fa6SStefano Zampini     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size,0,1,&is_dummy);CHKERRQ(ierr);
10248bec7fa6SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);
10258bec7fa6SStefano Zampini     ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
10268bec7fa6SStefano Zampini     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
10278bec7fa6SStefano Zampini     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
10288bec7fa6SStefano Zampini     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
10298bec7fa6SStefano Zampini     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
10308bec7fa6SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
10318bec7fa6SStefano Zampini     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
10328bec7fa6SStefano Zampini     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
10338bec7fa6SStefano Zampini     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
10348bec7fa6SStefano Zampini     ierr = VecDestroy(&mones);CHKERRQ(ierr);
10358bec7fa6SStefano Zampini 
103625084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
103788ebb749SStefano Zampini     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
103888ebb749SStefano Zampini     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
103988ebb749SStefano Zampini     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
104088ebb749SStefano Zampini     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
104188ebb749SStefano Zampini     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
104288ebb749SStefano Zampini     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
104388ebb749SStefano Zampini     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
104488ebb749SStefano Zampini     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
104588ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
104688ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
1047c0553b1fSStefano Zampini     if (unsymmetric_check) {
104888ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
104988ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
105088ebb749SStefano Zampini     }
105188ebb749SStefano Zampini     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
105288ebb749SStefano Zampini   }
105306656605SStefano Zampini 
105488ebb749SStefano Zampini   /* free memory */
105506656605SStefano Zampini   ierr = PetscFree(work);CHKERRQ(ierr);
105688ebb749SStefano Zampini   if (n_vertices) {
105788ebb749SStefano Zampini     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
105888ebb749SStefano Zampini   }
105988ebb749SStefano Zampini   if (n_constraints) {
106088ebb749SStefano Zampini     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
106188ebb749SStefano Zampini   }
10628629588bSStefano Zampini   /* get back data */
10638629588bSStefano Zampini   *coarse_submat_vals_n = coarse_submat_vals;
106488ebb749SStefano Zampini   PetscFunctionReturn(0);
106588ebb749SStefano Zampini }
106688ebb749SStefano Zampini 
106788ebb749SStefano Zampini #undef __FUNCT__
1068d65f70fdSStefano Zampini #define __FUNCT__ "MatGetSubMatrixUnsorted"
1069d648f858SStefano Zampini PetscErrorCode MatGetSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
1070d65f70fdSStefano Zampini {
1071d65f70fdSStefano Zampini   Mat            *work_mat;
1072d65f70fdSStefano Zampini   IS             isrow_s,iscol_s;
1073d65f70fdSStefano Zampini   PetscBool      rsorted,csorted;
1074d65f70fdSStefano Zampini   PetscInt       rsize,*idxs_perm_r,csize,*idxs_perm_c;
1075d65f70fdSStefano Zampini   PetscErrorCode ierr;
1076d65f70fdSStefano Zampini 
1077d65f70fdSStefano Zampini   PetscFunctionBegin;
1078d65f70fdSStefano Zampini   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
1079d65f70fdSStefano Zampini   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
1080d65f70fdSStefano Zampini   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
1081d65f70fdSStefano Zampini   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
1082d65f70fdSStefano Zampini 
1083d65f70fdSStefano Zampini   if (!rsorted) {
1084d65f70fdSStefano Zampini     const PetscInt *idxs;
1085d65f70fdSStefano Zampini     PetscInt *idxs_sorted,i;
1086d65f70fdSStefano Zampini 
1087d65f70fdSStefano Zampini     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
1088d65f70fdSStefano Zampini     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
1089d65f70fdSStefano Zampini     for (i=0;i<rsize;i++) {
1090d65f70fdSStefano Zampini       idxs_perm_r[i] = i;
1091d65f70fdSStefano Zampini     }
1092d65f70fdSStefano Zampini     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
1093d65f70fdSStefano Zampini     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
1094d65f70fdSStefano Zampini     for (i=0;i<rsize;i++) {
1095d65f70fdSStefano Zampini       idxs_sorted[i] = idxs[idxs_perm_r[i]];
1096d65f70fdSStefano Zampini     }
1097d65f70fdSStefano Zampini     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
1098d65f70fdSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
1099d65f70fdSStefano Zampini   } else {
1100d65f70fdSStefano Zampini     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
1101d65f70fdSStefano Zampini     isrow_s = isrow;
1102d65f70fdSStefano Zampini   }
1103d65f70fdSStefano Zampini 
1104d65f70fdSStefano Zampini   if (!csorted) {
1105d65f70fdSStefano Zampini     if (isrow == iscol) {
1106d65f70fdSStefano Zampini       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
1107d65f70fdSStefano Zampini       iscol_s = isrow_s;
1108d65f70fdSStefano Zampini     } else {
1109d65f70fdSStefano Zampini       const PetscInt *idxs;
1110d65f70fdSStefano Zampini       PetscInt *idxs_sorted,i;
1111d65f70fdSStefano Zampini 
1112d65f70fdSStefano Zampini       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
1113d65f70fdSStefano Zampini       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
1114d65f70fdSStefano Zampini       for (i=0;i<csize;i++) {
1115d65f70fdSStefano Zampini         idxs_perm_c[i] = i;
1116d65f70fdSStefano Zampini       }
1117d65f70fdSStefano Zampini       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
1118d65f70fdSStefano Zampini       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
1119d65f70fdSStefano Zampini       for (i=0;i<csize;i++) {
1120d65f70fdSStefano Zampini         idxs_sorted[i] = idxs[idxs_perm_c[i]];
1121d65f70fdSStefano Zampini       }
1122d65f70fdSStefano Zampini       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
1123d65f70fdSStefano Zampini       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
1124d65f70fdSStefano Zampini     }
1125d65f70fdSStefano Zampini   } else {
1126d65f70fdSStefano Zampini     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
1127d65f70fdSStefano Zampini     iscol_s = iscol;
1128d65f70fdSStefano Zampini   }
1129d65f70fdSStefano Zampini 
1130d648f858SStefano Zampini   ierr = MatGetSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
1131d65f70fdSStefano Zampini 
1132d65f70fdSStefano Zampini   if (!rsorted || !csorted) {
1133d65f70fdSStefano Zampini     Mat      new_mat;
1134d65f70fdSStefano Zampini     IS       is_perm_r,is_perm_c;
1135d65f70fdSStefano Zampini 
1136d65f70fdSStefano Zampini     if (!rsorted) {
1137d65f70fdSStefano Zampini       PetscInt *idxs_r,i;
1138d65f70fdSStefano Zampini       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
1139d65f70fdSStefano Zampini       for (i=0;i<rsize;i++) {
1140d65f70fdSStefano Zampini         idxs_r[idxs_perm_r[i]] = i;
1141d65f70fdSStefano Zampini       }
1142d65f70fdSStefano Zampini       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
1143d65f70fdSStefano Zampini       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
1144d65f70fdSStefano Zampini     } else {
1145d65f70fdSStefano Zampini       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
1146d65f70fdSStefano Zampini     }
1147d65f70fdSStefano Zampini     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
1148d65f70fdSStefano Zampini 
1149d65f70fdSStefano Zampini     if (!csorted) {
1150d65f70fdSStefano Zampini       if (isrow_s == iscol_s) {
1151d65f70fdSStefano Zampini         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
1152d65f70fdSStefano Zampini         is_perm_c = is_perm_r;
1153d65f70fdSStefano Zampini       } else {
1154d65f70fdSStefano Zampini         PetscInt *idxs_c,i;
1155d65f70fdSStefano Zampini         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
1156d65f70fdSStefano Zampini         for (i=0;i<csize;i++) {
1157d65f70fdSStefano Zampini           idxs_c[idxs_perm_c[i]] = i;
1158d65f70fdSStefano Zampini         }
1159d65f70fdSStefano Zampini         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
1160d65f70fdSStefano Zampini         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
1161d65f70fdSStefano Zampini       }
1162d65f70fdSStefano Zampini     } else {
1163d65f70fdSStefano Zampini       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
1164d65f70fdSStefano Zampini     }
1165d65f70fdSStefano Zampini     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
1166d65f70fdSStefano Zampini 
1167d65f70fdSStefano Zampini     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
1168d65f70fdSStefano Zampini     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
1169d65f70fdSStefano Zampini     work_mat[0] = new_mat;
1170d65f70fdSStefano Zampini     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
1171d65f70fdSStefano Zampini     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
1172d65f70fdSStefano Zampini   }
1173d65f70fdSStefano Zampini 
1174d65f70fdSStefano Zampini   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
1175d65f70fdSStefano Zampini   *B = work_mat[0];
1176d65f70fdSStefano Zampini   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
1177d65f70fdSStefano Zampini   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
1178d65f70fdSStefano Zampini   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
1179d65f70fdSStefano Zampini   PetscFunctionReturn(0);
1180d65f70fdSStefano Zampini }
1181d65f70fdSStefano Zampini 
1182d65f70fdSStefano Zampini #undef __FUNCT__
11835e8657edSStefano Zampini #define __FUNCT__ "PCBDDCComputeLocalMatrix"
11845e8657edSStefano Zampini PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
1185aa0d41d4SStefano Zampini {
1186aa0d41d4SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
11875e8657edSStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
1188d65f70fdSStefano Zampini   Mat            new_mat;
11895e8657edSStefano Zampini   IS             is_local,is_global;
1190d65f70fdSStefano Zampini   PetscInt       local_size;
1191d65f70fdSStefano Zampini   PetscBool      isseqaij;
1192aa0d41d4SStefano Zampini   PetscErrorCode ierr;
1193aa0d41d4SStefano Zampini 
1194aa0d41d4SStefano Zampini   PetscFunctionBegin;
1195aa0d41d4SStefano Zampini   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
11965e8657edSStefano Zampini   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
11975e8657edSStefano Zampini   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
1198906d46d4SStefano Zampini   ierr = ISLocalToGlobalMappingApplyIS(matis->mapping,is_local,&is_global);CHKERRQ(ierr);
1199906d46d4SStefano Zampini   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
1200d648f858SStefano Zampini   ierr = MatGetSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
1201906d46d4SStefano Zampini   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
1202906d46d4SStefano Zampini 
1203906d46d4SStefano Zampini   /* check */
1204906d46d4SStefano Zampini   if (pcbddc->dbg_flag) {
1205906d46d4SStefano Zampini     Vec       x,x_change;
1206906d46d4SStefano Zampini     PetscReal error;
1207906d46d4SStefano Zampini 
12085e8657edSStefano Zampini     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
1209906d46d4SStefano Zampini     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
12105e8657edSStefano Zampini     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
12115e8657edSStefano Zampini     ierr = VecScatterBegin(matis->ctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
12125e8657edSStefano Zampini     ierr = VecScatterEnd(matis->ctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1213d65f70fdSStefano Zampini     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
12145e8657edSStefano Zampini     ierr = VecScatterBegin(matis->ctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
12155e8657edSStefano Zampini     ierr = VecScatterEnd(matis->ctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1216906d46d4SStefano Zampini     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
1217906d46d4SStefano Zampini     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
1218906d46d4SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1219906d46d4SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Error global vs local change on N: %1.6e\n",error);CHKERRQ(ierr);
1220906d46d4SStefano Zampini     ierr = VecDestroy(&x);CHKERRQ(ierr);
1221906d46d4SStefano Zampini     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
1222906d46d4SStefano Zampini   }
1223906d46d4SStefano Zampini 
122422d5777bSStefano Zampini   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
12259b28b3ffSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
122622d5777bSStefano Zampini   if (isseqaij) {
1227d65f70fdSStefano Zampini     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
1228aa0d41d4SStefano Zampini   } else {
1229aa0d41d4SStefano Zampini     Mat work_mat;
1230aa0d41d4SStefano Zampini     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
1231d65f70fdSStefano Zampini     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
1232aa0d41d4SStefano Zampini     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
1233aa0d41d4SStefano Zampini   }
1234d65f70fdSStefano Zampini   ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,pcbddc->issym);CHKERRQ(ierr);
1235e496cd5dSStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1236e496cd5dSStefano Zampini   ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,pcbddc->issym);CHKERRQ(ierr);
1237e496cd5dSStefano Zampini #endif
123845a1bb75SStefano Zampini   /*
123945a1bb75SStefano Zampini   ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
1240d65f70fdSStefano Zampini   ierr = MatView(new_mat,(PetscViewer)0);CHKERRQ(ierr);
124145a1bb75SStefano Zampini   */
1242d65f70fdSStefano Zampini   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
1243aa0d41d4SStefano Zampini   PetscFunctionReturn(0);
1244aa0d41d4SStefano Zampini }
1245aa0d41d4SStefano Zampini 
1246aa0d41d4SStefano Zampini #undef __FUNCT__
1247a64d13efSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalScatters"
12488ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
1249a64d13efSStefano Zampini {
1250a64d13efSStefano Zampini   PC_IS*         pcis = (PC_IS*)(pc->data);
1251a64d13efSStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
12528ce42a96SStefano Zampini   IS             is_aux1,is_aux2;
1253e9189074SStefano Zampini   PetscInt       *aux_array1,*aux_array2,*is_indices,*idx_R_local;
12543a50541eSStefano Zampini   PetscInt       n_vertices,i,j,n_R,n_D,n_B;
12553a50541eSStefano Zampini   PetscInt       vbs,bs;
12564641a718SStefano Zampini   PetscBT        bitmask;
1257a64d13efSStefano Zampini   PetscErrorCode ierr;
1258a64d13efSStefano Zampini 
1259a64d13efSStefano Zampini   PetscFunctionBegin;
1260b23d619eSStefano Zampini   /*
1261b23d619eSStefano Zampini     No need to setup local scatters if
1262b23d619eSStefano Zampini       - primal space is unchanged
1263b23d619eSStefano Zampini         AND
1264b23d619eSStefano Zampini       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
1265b23d619eSStefano Zampini         AND
1266b23d619eSStefano Zampini       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
1267b23d619eSStefano Zampini   */
1268b23d619eSStefano Zampini   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
1269f4ddd8eeSStefano Zampini     PetscFunctionReturn(0);
1270f4ddd8eeSStefano Zampini   }
1271f4ddd8eeSStefano Zampini   /* destroy old objects */
1272f4ddd8eeSStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
1273f4ddd8eeSStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
1274f4ddd8eeSStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
1275a64d13efSStefano Zampini   /* Set Non-overlapping dimensions */
1276a64d13efSStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
1277e9189074SStefano Zampini   n_vertices = pcbddc->n_actual_vertices;
12784641a718SStefano Zampini   /* create auxiliary bitmask */
12794641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
12804641a718SStefano Zampini   for (i=0;i<n_vertices;i++) {
1281e9189074SStefano Zampini     ierr = PetscBTSet(bitmask,pcbddc->primal_indices_local_idxs[i]);CHKERRQ(ierr);
12824641a718SStefano Zampini   }
12833a50541eSStefano Zampini 
1284a64d13efSStefano Zampini   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
1285854ce69bSBarry Smith   ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
1286a64d13efSStefano Zampini   for (i=0, n_R=0; i<pcis->n; i++) {
12874641a718SStefano Zampini     if (!PetscBTLookup(bitmask,i)) {
1288a64d13efSStefano Zampini       idx_R_local[n_R] = i;
1289a64d13efSStefano Zampini       n_R++;
1290a64d13efSStefano Zampini     }
1291a64d13efSStefano Zampini   }
12923a50541eSStefano Zampini 
12933a50541eSStefano Zampini   /* Block code */
12943a50541eSStefano Zampini   vbs = 1;
12953a50541eSStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
12963a50541eSStefano Zampini   if (bs>1 && !(n_vertices%bs)) {
12973a50541eSStefano Zampini     PetscBool is_blocked = PETSC_TRUE;
12983a50541eSStefano Zampini     PetscInt  *vary;
12993a50541eSStefano Zampini     /* Verify if the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
1300785e854fSJed Brown     ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
13013a50541eSStefano Zampini     ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
1302e9189074SStefano Zampini     for (i=0; i<n_vertices; i++) vary[pcbddc->primal_indices_local_idxs[i]/bs]++;
1303964fefecSStefano Zampini     for (i=0; i<n_vertices/bs; i++) {
13043a50541eSStefano Zampini       if (vary[i]!=0 && vary[i]!=bs) {
13053a50541eSStefano Zampini         is_blocked = PETSC_FALSE;
13063a50541eSStefano Zampini         break;
13073a50541eSStefano Zampini       }
13083a50541eSStefano Zampini     }
13093a50541eSStefano Zampini     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
13103a50541eSStefano Zampini       vbs = bs;
13113a50541eSStefano Zampini       for (i=0;i<n_R/vbs;i++) {
13123a50541eSStefano Zampini         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
13133a50541eSStefano Zampini       }
13143a50541eSStefano Zampini     }
13153a50541eSStefano Zampini     ierr = PetscFree(vary);CHKERRQ(ierr);
13163a50541eSStefano Zampini   }
13173a50541eSStefano Zampini   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
13183a50541eSStefano Zampini   ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
1319a64d13efSStefano Zampini 
1320a64d13efSStefano Zampini   /* print some info if requested */
1321a64d13efSStefano Zampini   if (pcbddc->dbg_flag) {
1322a64d13efSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1323a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
13240fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1325a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
1326a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
13273a50541eSStefano 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);
1328a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr);
1329a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1330a64d13efSStefano Zampini   }
1331a64d13efSStefano Zampini 
1332a64d13efSStefano Zampini   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
13333a50541eSStefano Zampini   ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
1334854ce69bSBarry Smith   ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
1335854ce69bSBarry Smith   ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
1336a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
13374641a718SStefano Zampini   for (i=0; i<n_D; i++) {
13384641a718SStefano Zampini     ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
13394641a718SStefano Zampini   }
1340a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1341a64d13efSStefano Zampini   for (i=0, j=0; i<n_R; i++) {
13424641a718SStefano Zampini     if (!PetscBTLookup(bitmask,idx_R_local[i])) {
13434641a718SStefano Zampini       aux_array1[j++] = i;
1344a64d13efSStefano Zampini     }
1345a64d13efSStefano Zampini   }
1346a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
1347a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1348a64d13efSStefano Zampini   for (i=0, j=0; i<n_B; i++) {
13494641a718SStefano Zampini     if (!PetscBTLookup(bitmask,is_indices[i])) {
13504641a718SStefano Zampini       aux_array2[j++] = i;
1351a64d13efSStefano Zampini     }
1352a64d13efSStefano Zampini   }
1353a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1354a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
1355a64d13efSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
1356a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
1357a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
1358a64d13efSStefano Zampini 
13598eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
1360785e854fSJed Brown     ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
1361a64d13efSStefano Zampini     for (i=0, j=0; i<n_R; i++) {
13624641a718SStefano Zampini       if (PetscBTLookup(bitmask,idx_R_local[i])) {
13634641a718SStefano Zampini         aux_array1[j++] = i;
1364a64d13efSStefano Zampini       }
1365a64d13efSStefano Zampini     }
1366a64d13efSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
1367a64d13efSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
1368a64d13efSStefano Zampini     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
1369a64d13efSStefano Zampini   }
13704641a718SStefano Zampini   ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
13713a50541eSStefano Zampini   ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
1372a64d13efSStefano Zampini   PetscFunctionReturn(0);
1373a64d13efSStefano Zampini }
1374a64d13efSStefano Zampini 
1375304d26faSStefano Zampini 
1376304d26faSStefano Zampini #undef __FUNCT__
1377304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
1378684f6988SStefano Zampini PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
1379304d26faSStefano Zampini {
1380304d26faSStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1381304d26faSStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
1382304d26faSStefano Zampini   PC             pc_temp;
1383304d26faSStefano Zampini   Mat            A_RR;
1384f4ddd8eeSStefano Zampini   MatReuse       reuse;
1385304d26faSStefano Zampini   PetscScalar    m_one = -1.0;
1386304d26faSStefano Zampini   PetscReal      value;
1387af732b37SStefano Zampini   PetscInt       n_D,n_R,ibs,mbs;
13889577ea80SStefano Zampini   PetscBool      use_exact,use_exact_reduced,issbaij;
1389304d26faSStefano Zampini   PetscErrorCode ierr;
1390e604994aSStefano Zampini   /* prefixes stuff */
1391312be037SStefano Zampini   char           dir_prefix[256],neu_prefix[256],str_level[16];
1392e604994aSStefano Zampini   size_t         len;
1393304d26faSStefano Zampini 
1394304d26faSStefano Zampini   PetscFunctionBegin;
1395304d26faSStefano Zampini 
1396e604994aSStefano Zampini   /* compute prefixes */
1397e604994aSStefano Zampini   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
1398e604994aSStefano Zampini   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
1399e604994aSStefano Zampini   if (!pcbddc->current_level) {
1400e604994aSStefano Zampini     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
1401e604994aSStefano Zampini     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
1402e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
1403e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
1404e604994aSStefano Zampini   } else {
1405e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
1406312be037SStefano Zampini     sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
1407e604994aSStefano Zampini     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
1408e604994aSStefano Zampini     len -= 15; /* remove "pc_bddc_coarse_" */
1409312be037SStefano Zampini     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
1410312be037SStefano Zampini     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
141134d6797cSStefano Zampini     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
141234d6797cSStefano Zampini     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
1413e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
1414e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
1415e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
1416e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
1417e604994aSStefano Zampini   }
1418e604994aSStefano Zampini 
1419304d26faSStefano Zampini   /* DIRICHLET PROBLEM */
1420684f6988SStefano Zampini   if (dirichlet) {
1421964fefecSStefano Zampini     if (pcbddc->issym) {
1422964fefecSStefano Zampini       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
1423964fefecSStefano Zampini     }
1424ac78edfcSStefano Zampini     /* Matrix for Dirichlet problem is pcis->A_II */
1425964fefecSStefano Zampini     n_D = pcis->n - pcis->n_B;
1426304d26faSStefano Zampini     if (!pcbddc->ksp_D) { /* create object if not yet build */
1427304d26faSStefano Zampini       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
1428304d26faSStefano Zampini       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
1429304d26faSStefano Zampini       /* default */
1430304d26faSStefano Zampini       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
1431e604994aSStefano Zampini       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
14329577ea80SStefano Zampini       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
1433304d26faSStefano Zampini       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
14349577ea80SStefano Zampini       if (issbaij) {
14359577ea80SStefano Zampini         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
14369577ea80SStefano Zampini       } else {
1437304d26faSStefano Zampini         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
14389577ea80SStefano Zampini       }
1439304d26faSStefano Zampini       /* Allow user's customization */
1440304d26faSStefano Zampini       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
1441304d26faSStefano Zampini       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1442304d26faSStefano Zampini     }
1443d1e9a80fSBarry Smith     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
1444304d26faSStefano Zampini     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1445304d26faSStefano Zampini     if (!n_D) {
1446304d26faSStefano Zampini       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
1447304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1448304d26faSStefano Zampini     }
1449304d26faSStefano Zampini     /* Set Up KSP for Dirichlet problem of BDDC */
1450304d26faSStefano Zampini     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
1451304d26faSStefano Zampini     /* set ksp_D into pcis data */
1452304d26faSStefano Zampini     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
1453304d26faSStefano Zampini     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
1454304d26faSStefano Zampini     pcis->ksp_D = pcbddc->ksp_D;
1455684f6988SStefano Zampini   }
1456304d26faSStefano Zampini 
1457304d26faSStefano Zampini   /* NEUMANN PROBLEM */
1458684f6988SStefano Zampini   A_RR = 0;
1459684f6988SStefano Zampini   if (neumann) {
1460f4ddd8eeSStefano Zampini     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
14618ce42a96SStefano Zampini     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
1462f4ddd8eeSStefano Zampini     if (pcbddc->ksp_R) { /* already created ksp */
1463f4ddd8eeSStefano Zampini       PetscInt nn_R;
146481d9aea3SBarry Smith       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
1465f4ddd8eeSStefano Zampini       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
1466f4ddd8eeSStefano Zampini       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
1467f4ddd8eeSStefano Zampini       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
1468f4ddd8eeSStefano Zampini         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
1469f4ddd8eeSStefano Zampini         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1470f4ddd8eeSStefano Zampini         reuse = MAT_INITIAL_MATRIX;
1471f4ddd8eeSStefano Zampini       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
1472727cdba6SStefano Zampini         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
1473f4ddd8eeSStefano Zampini           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1474f4ddd8eeSStefano Zampini           reuse = MAT_INITIAL_MATRIX;
1475f4ddd8eeSStefano Zampini         } else { /* safe to reuse the matrix */
1476f4ddd8eeSStefano Zampini           reuse = MAT_REUSE_MATRIX;
1477f4ddd8eeSStefano Zampini         }
1478f4ddd8eeSStefano Zampini       }
1479f4ddd8eeSStefano Zampini       /* last check */
1480d1e9a80fSBarry Smith       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
1481f4ddd8eeSStefano Zampini         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1482f4ddd8eeSStefano Zampini         reuse = MAT_INITIAL_MATRIX;
1483f4ddd8eeSStefano Zampini       }
1484f4ddd8eeSStefano Zampini     } else { /* first time, so we need to create the matrix */
1485f4ddd8eeSStefano Zampini       reuse = MAT_INITIAL_MATRIX;
1486f4ddd8eeSStefano Zampini     }
1487f4ddd8eeSStefano Zampini     /* extract A_RR */
1488af732b37SStefano Zampini     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
1489af732b37SStefano Zampini     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
14903a50541eSStefano Zampini     if (ibs != mbs) {
1491af732b37SStefano Zampini       Mat newmat;
1492af732b37SStefano Zampini       ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
1493f4ddd8eeSStefano Zampini       ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
1494af732b37SStefano Zampini       ierr = MatDestroy(&newmat);CHKERRQ(ierr);
1495af732b37SStefano Zampini     } else {
1496f4ddd8eeSStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
1497af732b37SStefano Zampini     }
1498964fefecSStefano Zampini     if (pcbddc->issym) {
1499964fefecSStefano Zampini       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
1500964fefecSStefano Zampini     }
1501f4ddd8eeSStefano Zampini     if (!pcbddc->ksp_R) { /* create object if not present */
1502304d26faSStefano Zampini       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
1503304d26faSStefano Zampini       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
1504304d26faSStefano Zampini       /* default */
1505304d26faSStefano Zampini       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
1506e604994aSStefano Zampini       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
1507304d26faSStefano Zampini       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
15089577ea80SStefano Zampini       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
15099577ea80SStefano Zampini       if (issbaij) {
15109577ea80SStefano Zampini         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
15119577ea80SStefano Zampini       } else {
1512304d26faSStefano Zampini         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
15139577ea80SStefano Zampini       }
1514304d26faSStefano Zampini       /* Allow user's customization */
1515304d26faSStefano Zampini       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
1516304d26faSStefano Zampini       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1517304d26faSStefano Zampini     }
1518d1e9a80fSBarry Smith     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
1519304d26faSStefano Zampini     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1520304d26faSStefano Zampini     if (!n_R) {
1521304d26faSStefano Zampini       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
1522304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1523304d26faSStefano Zampini     }
1524304d26faSStefano Zampini     /* Set Up KSP for Neumann problem of BDDC */
1525304d26faSStefano Zampini     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
1526684f6988SStefano Zampini   }
1527304d26faSStefano Zampini 
1528304d26faSStefano Zampini   /* check Dirichlet and Neumann solvers and adapt them if a nullspace correction is needed */
15290fccc4e9SStefano Zampini   if (pcbddc->NullSpace || pcbddc->dbg_flag) {
1530684f6988SStefano Zampini     if (pcbddc->dbg_flag) {
1531684f6988SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1532684f6988SStefano Zampini       ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1533684f6988SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1534684f6988SStefano Zampini     }
1535684f6988SStefano Zampini     if (dirichlet) { /* Dirichlet */
15360fccc4e9SStefano Zampini       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
15370fccc4e9SStefano Zampini       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
15380fccc4e9SStefano Zampini       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
15390fccc4e9SStefano Zampini       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
15400fccc4e9SStefano Zampini       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
1541304d26faSStefano Zampini       /* need to be adapted? */
1542b8ffe317SStefano Zampini       use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1543b8ffe317SStefano Zampini       ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1544b8ffe317SStefano Zampini       ierr = PCBDDCSetUseExactDirichlet(pc,use_exact_reduced);CHKERRQ(ierr);
1545304d26faSStefano Zampini       /* print info */
1546304d26faSStefano Zampini       if (pcbddc->dbg_flag) {
1547e604994aSStefano 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);
1548304d26faSStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1549304d26faSStefano Zampini       }
1550b8ffe317SStefano Zampini       if (pcbddc->NullSpace && !use_exact_reduced && !pcbddc->switch_static) {
15518ce42a96SStefano Zampini         ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcis->is_I_local);CHKERRQ(ierr);
1552304d26faSStefano Zampini       }
1553684f6988SStefano Zampini     }
1554684f6988SStefano Zampini     if (neumann) { /* Neumann */
15550fccc4e9SStefano Zampini       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
15560fccc4e9SStefano Zampini       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
15570fccc4e9SStefano Zampini       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
15580fccc4e9SStefano Zampini       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
15590fccc4e9SStefano Zampini       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
1560304d26faSStefano Zampini       /* need to be adapted? */
1561b8ffe317SStefano Zampini       use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1562b8ffe317SStefano Zampini       ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1563304d26faSStefano Zampini       /* print info */
1564304d26faSStefano Zampini       if (pcbddc->dbg_flag) {
1565e604994aSStefano 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);
1566304d26faSStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1567304d26faSStefano Zampini       }
1568b8ffe317SStefano Zampini       if (pcbddc->NullSpace && !use_exact_reduced) { /* is it the right logic? */
15698ce42a96SStefano Zampini         ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcbddc->is_R_local);CHKERRQ(ierr);
1570304d26faSStefano Zampini       }
15710fccc4e9SStefano Zampini     }
1572684f6988SStefano Zampini   }
1573304d26faSStefano Zampini   /* free Neumann problem's matrix */
1574304d26faSStefano Zampini   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1575304d26faSStefano Zampini   PetscFunctionReturn(0);
1576304d26faSStefano Zampini }
1577304d26faSStefano Zampini 
1578304d26faSStefano Zampini #undef __FUNCT__
1579ba15a52eSStefano Zampini #define __FUNCT__ "PCBDDCSolveSubstructureCorrection"
158020c7b377SStefano Zampini static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec rhs, Vec sol, Vec work, PetscBool applytranspose)
1581674ae819SStefano Zampini {
1582674ae819SStefano Zampini   PetscErrorCode ierr;
1583674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1584674ae819SStefano Zampini 
1585674ae819SStefano Zampini   PetscFunctionBegin;
158620c7b377SStefano Zampini   if (applytranspose) {
1587674ae819SStefano Zampini     if (pcbddc->local_auxmat1) {
158820c7b377SStefano Zampini       ierr = MatMultTranspose(pcbddc->local_auxmat2,rhs,work);CHKERRQ(ierr);
158920c7b377SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,work,rhs,rhs);CHKERRQ(ierr);
159020c7b377SStefano Zampini     }
159120c7b377SStefano Zampini     ierr = KSPSolveTranspose(pcbddc->ksp_R,rhs,sol);CHKERRQ(ierr);
159220c7b377SStefano Zampini   } else {
159320c7b377SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,rhs,sol);CHKERRQ(ierr);
159420c7b377SStefano Zampini     if (pcbddc->local_auxmat1) {
159520c7b377SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,sol,work);CHKERRQ(ierr);
159620c7b377SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,work,sol,sol);CHKERRQ(ierr);
159720c7b377SStefano Zampini     }
1598674ae819SStefano Zampini   }
1599674ae819SStefano Zampini   PetscFunctionReturn(0);
1600674ae819SStefano Zampini }
1601674ae819SStefano Zampini 
1602dc359a40SStefano Zampini /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
1603674ae819SStefano Zampini #undef __FUNCT__
1604674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
1605dc359a40SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
1606674ae819SStefano Zampini {
1607674ae819SStefano Zampini   PetscErrorCode ierr;
1608674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
1609674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
1610674ae819SStefano Zampini   const PetscScalar zero = 0.0;
1611674ae819SStefano Zampini 
1612674ae819SStefano Zampini   PetscFunctionBegin;
1613dc359a40SStefano Zampini   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
1614dc359a40SStefano Zampini   if (applytranspose) {
1615674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
16168eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
1617dc359a40SStefano Zampini   } else {
1618674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
1619674ae819SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
162015aaf578SStefano Zampini   }
162112edc857SStefano Zampini   /* start communications from local primal nodes to rhs of coarse solver */
162212edc857SStefano Zampini   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
162312edc857SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
162412edc857SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
162512edc857SStefano Zampini 
16269f00e9b4SStefano Zampini   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
162712edc857SStefano Zampini   /* TODO remove null space when doing multilevel */
162812edc857SStefano Zampini   if (pcbddc->coarse_ksp) {
1629964fefecSStefano Zampini     Vec rhs,sol;
1630964fefecSStefano Zampini 
1631964fefecSStefano Zampini     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
1632964fefecSStefano Zampini     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
163312edc857SStefano Zampini     if (applytranspose) {
1634964fefecSStefano Zampini       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
163512edc857SStefano Zampini     } else {
1636964fefecSStefano Zampini       ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
163712edc857SStefano Zampini     }
163812edc857SStefano Zampini   }
1639674ae819SStefano Zampini 
1640674ae819SStefano Zampini   /* Local solution on R nodes */
16419f00e9b4SStefano Zampini   if (pcis->n) {
1642674ae819SStefano Zampini     ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1643674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1644674ae819SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
16458eeda7d8SStefano Zampini     if (pcbddc->switch_static) {
1646674ae819SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1647674ae819SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1648674ae819SStefano Zampini     }
164920c7b377SStefano Zampini     ierr = PCBDDCSolveSubstructureCorrection(pc,pcbddc->vec1_R,pcbddc->vec2_R,pcbddc->vec1_C,applytranspose);CHKERRQ(ierr);
1650674ae819SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1651674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1652674ae819SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
16538eeda7d8SStefano Zampini     if (pcbddc->switch_static) {
1654674ae819SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1655674ae819SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1656674ae819SStefano Zampini     }
16579f00e9b4SStefano Zampini   }
1658674ae819SStefano Zampini 
16599f00e9b4SStefano Zampini   /* communications from coarse sol to local primal nodes */
16609f00e9b4SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
166112edc857SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1662674ae819SStefano Zampini 
1663674ae819SStefano Zampini   /* Sum contributions from two levels */
1664dc359a40SStefano Zampini   if (applytranspose) {
1665dc359a40SStefano Zampini     ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
1666dc359a40SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1667dc359a40SStefano Zampini   } else {
1668674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
16698eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1670dc359a40SStefano Zampini   }
1671674ae819SStefano Zampini   PetscFunctionReturn(0);
1672674ae819SStefano Zampini }
1673674ae819SStefano Zampini 
1674674ae819SStefano Zampini #undef __FUNCT__
1675674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
167612edc857SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
1677674ae819SStefano Zampini {
1678674ae819SStefano Zampini   PetscErrorCode ierr;
1679674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
168058da7f69SStefano Zampini   PetscScalar    *array;
168112edc857SStefano Zampini   Vec            from,to;
1682674ae819SStefano Zampini 
1683674ae819SStefano Zampini   PetscFunctionBegin;
168412edc857SStefano Zampini   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
168512edc857SStefano Zampini     from = pcbddc->coarse_vec;
168612edc857SStefano Zampini     to = pcbddc->vec1_P;
168712edc857SStefano Zampini     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
168812edc857SStefano Zampini       Vec tvec;
168958da7f69SStefano Zampini 
169058da7f69SStefano Zampini       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
169158da7f69SStefano Zampini       ierr = VecResetArray(tvec);CHKERRQ(ierr);
169212edc857SStefano Zampini       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
169358da7f69SStefano Zampini       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
169458da7f69SStefano Zampini       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
169558da7f69SStefano Zampini       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
169612edc857SStefano Zampini     }
169712edc857SStefano Zampini   } else { /* from local to global -> put data in coarse right hand side */
169812edc857SStefano Zampini     from = pcbddc->vec1_P;
169912edc857SStefano Zampini     to = pcbddc->coarse_vec;
170012edc857SStefano Zampini   }
170112edc857SStefano Zampini   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
1702674ae819SStefano Zampini   PetscFunctionReturn(0);
1703674ae819SStefano Zampini }
1704674ae819SStefano Zampini 
1705674ae819SStefano Zampini #undef __FUNCT__
1706674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
170712edc857SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
1708674ae819SStefano Zampini {
1709674ae819SStefano Zampini   PetscErrorCode ierr;
1710674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
171158da7f69SStefano Zampini   PetscScalar    *array;
171212edc857SStefano Zampini   Vec            from,to;
1713674ae819SStefano Zampini 
1714674ae819SStefano Zampini   PetscFunctionBegin;
171512edc857SStefano Zampini   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
171612edc857SStefano Zampini     from = pcbddc->coarse_vec;
171712edc857SStefano Zampini     to = pcbddc->vec1_P;
171812edc857SStefano Zampini   } else { /* from local to global -> put data in coarse right hand side */
171912edc857SStefano Zampini     from = pcbddc->vec1_P;
172012edc857SStefano Zampini     to = pcbddc->coarse_vec;
172112edc857SStefano Zampini   }
172212edc857SStefano Zampini   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
172312edc857SStefano Zampini   if (smode == SCATTER_FORWARD) {
172412edc857SStefano Zampini     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
172512edc857SStefano Zampini       Vec tvec;
172658da7f69SStefano Zampini 
172712edc857SStefano Zampini       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
172858da7f69SStefano Zampini       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
172958da7f69SStefano Zampini       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
173058da7f69SStefano Zampini       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
173158da7f69SStefano Zampini     }
173258da7f69SStefano Zampini   } else {
173358da7f69SStefano Zampini     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
173458da7f69SStefano Zampini      ierr = VecResetArray(from);CHKERRQ(ierr);
173512edc857SStefano Zampini     }
173612edc857SStefano Zampini   }
1737674ae819SStefano Zampini   PetscFunctionReturn(0);
1738674ae819SStefano Zampini }
1739674ae819SStefano Zampini 
1740984c4197SStefano Zampini /* uncomment for testing purposes */
1741984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */
1742674ae819SStefano Zampini #undef __FUNCT__
1743674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
1744674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
1745674ae819SStefano Zampini {
1746674ae819SStefano Zampini   PetscErrorCode    ierr;
1747674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
1748674ae819SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1749674ae819SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
1750984c4197SStefano Zampini   /* one and zero */
1751984c4197SStefano Zampini   PetscScalar       one=1.0,zero=0.0;
1752984c4197SStefano Zampini   /* space to store constraints and their local indices */
1753984c4197SStefano Zampini   PetscScalar       *temp_quadrature_constraint;
1754984c4197SStefano Zampini   PetscInt          *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B;
1755984c4197SStefano Zampini   /* iterators */
1756984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
1757984c4197SStefano Zampini   /* BLAS integers */
1758e310c8b4SStefano Zampini   PetscBLASInt      lwork,lierr;
1759e310c8b4SStefano Zampini   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
1760c4303822SStefano Zampini   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
1761727cdba6SStefano Zampini   /* reuse */
1762727cdba6SStefano Zampini   PetscInt          olocal_primal_size;
1763727cdba6SStefano Zampini   PetscInt          *oprimal_indices_local_idxs;
1764984c4197SStefano Zampini   /* change of basis */
1765984c4197SStefano Zampini   PetscInt          *aux_primal_numbering,*aux_primal_minloc,*global_indices;
1766a717540cSStefano Zampini   PetscBool         boolforchange,qr_needed;
1767a717540cSStefano Zampini   PetscBT           touched,change_basis,qr_needed_idx;
1768984c4197SStefano Zampini   /* auxiliary stuff */
176939e2fb2aSStefano Zampini   PetscInt          *nnz,*is_indices,*aux_primal_numbering_B;
1770a58a30b4SStefano Zampini   PetscInt          ncc,*gidxs=NULL,*permutation=NULL,*temp_indices_to_constraint_work=NULL;
1771a58a30b4SStefano Zampini   PetscScalar       *temp_quadrature_constraint_work=NULL;
1772984c4197SStefano Zampini   /* some quantities */
177345a1bb75SStefano Zampini   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
1774a58a30b4SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
1775984c4197SStefano Zampini 
1776674ae819SStefano Zampini   PetscFunctionBegin;
17778e61c736SStefano Zampini   /* Destroy Mat objects computed previously */
17788e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
17798e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1780cf5a6209SStefano Zampini 
1781cf5a6209SStefano Zampini   /* print some info */
1782cf5a6209SStefano Zampini   if (pcbddc->dbg_flag) {
1783cf5a6209SStefano Zampini     IS       vertices;
1784cf5a6209SStefano Zampini     PetscInt nv,nedges,nfaces;
1785cf5a6209SStefano Zampini     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
1786cf5a6209SStefano Zampini     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
1787cf5a6209SStefano Zampini     ierr = ISDestroy(&vertices);CHKERRQ(ierr);
1788cf5a6209SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1789cf5a6209SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1790cf5a6209SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
1791fd14bc51SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
1792fd14bc51SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
1793cf5a6209SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1794cf5a6209SStefano Zampini   }
1795cf5a6209SStefano Zampini 
1796cf5a6209SStefano Zampini   if (!pcbddc->adaptive_selection) {
1797cf5a6209SStefano Zampini     IS           ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
1798cf5a6209SStefano Zampini     MatNullSpace nearnullsp;
1799cf5a6209SStefano Zampini     const Vec    *nearnullvecs;
1800cf5a6209SStefano Zampini     Vec          *localnearnullsp;
1801cf5a6209SStefano Zampini     PetscScalar  *array;
1802cf5a6209SStefano Zampini     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
1803cf5a6209SStefano Zampini     PetscBool    nnsp_has_cnst;
1804cf5a6209SStefano Zampini     /* LAPACK working arrays for SVD or POD */
1805cf5a6209SStefano Zampini     PetscBool    skip_lapack;
1806cf5a6209SStefano Zampini     PetscScalar  *work;
1807cf5a6209SStefano Zampini     PetscReal    *singular_vals;
1808cf5a6209SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1809cf5a6209SStefano Zampini     PetscReal    *rwork;
1810cf5a6209SStefano Zampini #endif
1811cf5a6209SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1812cf5a6209SStefano Zampini     PetscScalar  *temp_basis,*correlation_mat;
1813cf5a6209SStefano Zampini #else
1814964fefecSStefano Zampini     PetscBLASInt dummy_int=1;
1815964fefecSStefano Zampini     PetscScalar  dummy_scalar=1.;
1816cf5a6209SStefano Zampini #endif
1817cf5a6209SStefano Zampini 
1818674ae819SStefano Zampini     /* Get index sets for faces, edges and vertices from graph */
1819d06fc5fdSStefano Zampini     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
1820d06fc5fdSStefano Zampini     /* free unneeded index sets */
1821d06fc5fdSStefano Zampini     if (!pcbddc->use_vertices) {
1822d06fc5fdSStefano Zampini       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
1823674ae819SStefano Zampini     }
1824d06fc5fdSStefano Zampini     if (!pcbddc->use_edges) {
1825d06fc5fdSStefano Zampini       for (i=0;i<n_ISForEdges;i++) {
1826d06fc5fdSStefano Zampini         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1827d06fc5fdSStefano Zampini       }
1828d06fc5fdSStefano Zampini       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1829d06fc5fdSStefano Zampini       n_ISForEdges = 0;
1830d06fc5fdSStefano Zampini     }
1831d06fc5fdSStefano Zampini     if (!pcbddc->use_faces) {
1832d06fc5fdSStefano Zampini       for (i=0;i<n_ISForFaces;i++) {
1833d06fc5fdSStefano Zampini         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1834d06fc5fdSStefano Zampini       }
1835d06fc5fdSStefano Zampini       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1836d06fc5fdSStefano Zampini       n_ISForFaces = 0;
1837d06fc5fdSStefano Zampini     }
1838d06fc5fdSStefano Zampini     /* HACKS (the following two blocks of code) */
1839b9b85e73SStefano Zampini     if (!ISForVertices && pcbddc->NullSpace && !pcbddc->user_ChangeOfBasisMatrix) {
1840b8ffe317SStefano Zampini       pcbddc->use_change_of_basis = PETSC_TRUE;
1841d06fc5fdSStefano Zampini       if (!ISForEdges) {
1842d06fc5fdSStefano Zampini         pcbddc->use_change_on_faces = PETSC_TRUE;
1843d06fc5fdSStefano Zampini       }
1844b8ffe317SStefano Zampini     }
184598a51de6SStefano Zampini     if (pcbddc->NullSpace) {
184698a51de6SStefano Zampini       /* use_change_of_basis should be consistent among processors */
1847d06fc5fdSStefano Zampini       PetscBool tbool[2],gbool[2];
1848d06fc5fdSStefano Zampini       tbool[0] = pcbddc->use_change_of_basis;
1849d06fc5fdSStefano Zampini       tbool[1] = pcbddc->use_change_on_faces;
1850d06fc5fdSStefano Zampini       ierr = MPI_Allreduce(tbool,gbool,2,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1851d06fc5fdSStefano Zampini       pcbddc->use_change_of_basis = gbool[0];
1852d06fc5fdSStefano Zampini       pcbddc->use_change_on_faces = gbool[1];
185398a51de6SStefano Zampini     }
185408122e43SStefano Zampini 
1855674ae819SStefano Zampini     /* check if near null space is attached to global mat */
1856674ae819SStefano Zampini     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
1857674ae819SStefano Zampini     if (nearnullsp) {
1858674ae819SStefano Zampini       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
1859f4ddd8eeSStefano Zampini       /* remove any stored info */
1860f4ddd8eeSStefano Zampini       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
1861f4ddd8eeSStefano Zampini       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1862f4ddd8eeSStefano Zampini       /* store information for BDDC solver reuse */
1863f4ddd8eeSStefano Zampini       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
1864f4ddd8eeSStefano Zampini       pcbddc->onearnullspace = nearnullsp;
1865473ba861SJed Brown       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1866f4ddd8eeSStefano Zampini       for (i=0;i<nnsp_size;i++) {
1867f4ddd8eeSStefano Zampini         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
1868f4ddd8eeSStefano Zampini       }
1869984c4197SStefano Zampini     } else { /* if near null space is not provided BDDC uses constants by default */
1870984c4197SStefano Zampini       nnsp_size = 0;
1871674ae819SStefano Zampini       nnsp_has_cnst = PETSC_TRUE;
1872674ae819SStefano Zampini     }
1873984c4197SStefano Zampini     /* get max number of constraints on a single cc */
1874984c4197SStefano Zampini     max_constraints = nnsp_size;
1875984c4197SStefano Zampini     if (nnsp_has_cnst) max_constraints++;
1876984c4197SStefano Zampini 
1877674ae819SStefano Zampini     /*
1878674ae819SStefano Zampini          Evaluate maximum storage size needed by the procedure
1879674ae819SStefano Zampini          - temp_indices will contain start index of each constraint stored as follows
1880911cabfeSStefano 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
1881911cabfeSStefano 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
1882911cabfeSStefano Zampini          - temp_quadrature_constraint  [temp_indices[i],...,temp_indices[i+1]-1] will contain the scalars representing the constraint itself
1883674ae819SStefano Zampini                                                                                                                                                            */
1884674ae819SStefano Zampini     total_counts = n_ISForFaces+n_ISForEdges;
1885984c4197SStefano Zampini     total_counts *= max_constraints;
1886674ae819SStefano Zampini     n_vertices = 0;
1887674ae819SStefano Zampini     if (ISForVertices) {
1888674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
1889674ae819SStefano Zampini     }
1890674ae819SStefano Zampini     total_counts += n_vertices;
1891854ce69bSBarry Smith     ierr = PetscMalloc1(total_counts+1,&temp_indices);CHKERRQ(ierr);
18924641a718SStefano Zampini     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
1893674ae819SStefano Zampini     total_counts = 0;
1894674ae819SStefano Zampini     max_size_of_constraint = 0;
1895674ae819SStefano Zampini     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1896674ae819SStefano Zampini       if (i<n_ISForEdges) {
1897674ae819SStefano Zampini         used_IS = &ISForEdges[i];
1898674ae819SStefano Zampini       } else {
1899674ae819SStefano Zampini         used_IS = &ISForFaces[i-n_ISForEdges];
1900674ae819SStefano Zampini       }
1901674ae819SStefano Zampini       ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
1902674ae819SStefano Zampini       total_counts += j;
1903674ae819SStefano Zampini       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
1904674ae819SStefano Zampini     }
1905984c4197SStefano Zampini     total_counts *= max_constraints;
1906674ae819SStefano Zampini     total_counts += n_vertices;
1907906d46d4SStefano Zampini     ierr = PetscMalloc3(total_counts,&temp_quadrature_constraint,total_counts,&temp_indices_to_constraint,total_counts,&temp_indices_to_constraint_B);CHKERRQ(ierr);
1908984c4197SStefano Zampini     /* get local part of global near null space vectors */
1909785e854fSJed Brown     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
1910984c4197SStefano Zampini     for (k=0;k<nnsp_size;k++) {
1911984c4197SStefano Zampini       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
1912984c4197SStefano Zampini       ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1913984c4197SStefano Zampini       ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1914984c4197SStefano Zampini     }
1915674ae819SStefano Zampini 
1916242a89d7SStefano Zampini     /* whether or not to skip lapack calls */
1917242a89d7SStefano Zampini     skip_lapack = PETSC_TRUE;
1918a773dcb8SStefano Zampini     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
1919242a89d7SStefano Zampini 
19208f1c130eSStefano Zampini     /* allocate some auxiliary stuff */
19218f1c130eSStefano Zampini     if (!skip_lapack || pcbddc->use_qr_single) {
19228f1c130eSStefano Zampini       ierr = PetscMalloc4(max_size_of_constraint,&gidxs,max_size_of_constraint,&permutation,max_size_of_constraint,&temp_indices_to_constraint_work,max_size_of_constraint,&temp_quadrature_constraint_work);CHKERRQ(ierr);
1923f9208b2eSJed Brown     } else {
1924f9208b2eSJed Brown       gidxs = NULL;
1925f9208b2eSJed Brown       permutation = NULL;
1926f9208b2eSJed Brown       temp_indices_to_constraint_work = NULL;
1927f9208b2eSJed Brown       temp_quadrature_constraint_work = NULL;
19288f1c130eSStefano Zampini     }
19298f1c130eSStefano Zampini 
1930984c4197SStefano Zampini     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
1931a773dcb8SStefano Zampini     if (!skip_lapack) {
1932674ae819SStefano Zampini       PetscScalar temp_work;
1933911cabfeSStefano Zampini 
1934674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1935984c4197SStefano Zampini       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
1936785e854fSJed Brown       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
1937785e854fSJed Brown       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
1938785e854fSJed Brown       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
1939674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1940785e854fSJed Brown       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
1941674ae819SStefano Zampini #endif
1942674ae819SStefano Zampini       /* now we evaluate the optimal workspace using query with lwork=-1 */
1943c8244a33SStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
1944c8244a33SStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
1945674ae819SStefano Zampini       lwork = -1;
1946674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1947674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1948c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
1949674ae819SStefano Zampini #else
1950c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
1951674ae819SStefano Zampini #endif
1952674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1953984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
1954674ae819SStefano Zampini #else /* on missing GESVD */
1955674ae819SStefano Zampini       /* SVD */
1956674ae819SStefano Zampini       PetscInt max_n,min_n;
1957674ae819SStefano Zampini       max_n = max_size_of_constraint;
1958984c4197SStefano Zampini       min_n = max_constraints;
1959984c4197SStefano Zampini       if (max_size_of_constraint < max_constraints) {
1960674ae819SStefano Zampini         min_n = max_size_of_constraint;
1961984c4197SStefano Zampini         max_n = max_constraints;
1962674ae819SStefano Zampini       }
1963785e854fSJed Brown       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
1964674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1965785e854fSJed Brown       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
1966674ae819SStefano Zampini #endif
1967674ae819SStefano Zampini       /* now we evaluate the optimal workspace using query with lwork=-1 */
1968674ae819SStefano Zampini       lwork = -1;
1969e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
1970e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
1971b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
1972674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1973674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1974cf5a6209SStefano 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));
1975674ae819SStefano Zampini #else
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,rwork,&lierr));
1977674ae819SStefano Zampini #endif
1978674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1979984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
1980984c4197SStefano Zampini #endif /* on missing GESVD */
1981674ae819SStefano Zampini       /* Allocate optimal workspace */
1982674ae819SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
1983854ce69bSBarry Smith       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
1984674ae819SStefano Zampini     }
1985674ae819SStefano Zampini     /* Now we can loop on constraining sets */
1986674ae819SStefano Zampini     total_counts = 0;
1987674ae819SStefano Zampini     temp_indices[0] = 0;
1988674ae819SStefano Zampini     /* vertices */
1989674ae819SStefano Zampini     if (ISForVertices) {
1990674ae819SStefano Zampini       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1991674ae819SStefano Zampini       if (nnsp_has_cnst) { /* consider all vertices */
199239e2fb2aSStefano Zampini         ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
1993674ae819SStefano Zampini         for (i=0;i<n_vertices;i++) {
1994674ae819SStefano Zampini           temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1995674ae819SStefano Zampini           temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1996674ae819SStefano Zampini           total_counts++;
1997674ae819SStefano Zampini         }
1998674ae819SStefano Zampini       } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
1999984c4197SStefano Zampini         PetscBool used_vertex;
2000674ae819SStefano Zampini         for (i=0;i<n_vertices;i++) {
2001674ae819SStefano Zampini           used_vertex = PETSC_FALSE;
2002674ae819SStefano Zampini           k = 0;
2003674ae819SStefano Zampini           while (!used_vertex && k<nnsp_size) {
2004984c4197SStefano Zampini             ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
2005984c4197SStefano Zampini             if (PetscAbsScalar(array[is_indices[i]])>0.0) {
2006674ae819SStefano Zampini               temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
2007674ae819SStefano Zampini               temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
2008674ae819SStefano Zampini               temp_indices[total_counts+1]=temp_indices[total_counts]+1;
2009674ae819SStefano Zampini               total_counts++;
2010674ae819SStefano Zampini               used_vertex = PETSC_TRUE;
2011674ae819SStefano Zampini             }
2012984c4197SStefano Zampini             ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
2013674ae819SStefano Zampini             k++;
2014674ae819SStefano Zampini           }
2015674ae819SStefano Zampini         }
2016674ae819SStefano Zampini       }
2017674ae819SStefano Zampini       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2018674ae819SStefano Zampini       n_vertices = total_counts;
2019674ae819SStefano Zampini     }
2020984c4197SStefano Zampini 
2021674ae819SStefano Zampini     /* edges and faces */
2022911cabfeSStefano Zampini     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
2023911cabfeSStefano Zampini       if (ncc<n_ISForEdges) {
2024911cabfeSStefano Zampini         used_IS = &ISForEdges[ncc];
2025984c4197SStefano Zampini         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
2026674ae819SStefano Zampini       } else {
2027911cabfeSStefano Zampini         used_IS = &ISForFaces[ncc-n_ISForEdges];
2028984c4197SStefano Zampini         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
2029674ae819SStefano Zampini       }
2030674ae819SStefano Zampini       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
2031674ae819SStefano Zampini       temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
2032674ae819SStefano Zampini       ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
2033674ae819SStefano Zampini       ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2034984c4197SStefano Zampini       /* change of basis should not be performed on local periodic nodes */
2035984c4197SStefano Zampini       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
2036674ae819SStefano Zampini       if (nnsp_has_cnst) {
20375b08dc53SStefano Zampini         PetscScalar quad_value;
2038674ae819SStefano Zampini         temp_constraints++;
2039a773dcb8SStefano Zampini         if (!pcbddc->use_nnsp_true) {
2040674ae819SStefano Zampini           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
2041a773dcb8SStefano Zampini         } else {
2042a773dcb8SStefano Zampini           quad_value = 1.0;
2043a773dcb8SStefano Zampini         }
204439e2fb2aSStefano Zampini         ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
2045674ae819SStefano Zampini         for (j=0;j<size_of_constraint;j++) {
2046674ae819SStefano Zampini           temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
2047674ae819SStefano Zampini         }
204808122e43SStefano Zampini         /* sort by global ordering if using lapack subroutines (not needed!) */
20498f1c130eSStefano Zampini         if (!skip_lapack || pcbddc->use_qr_single) {
2050911cabfeSStefano Zampini           ierr = ISLocalToGlobalMappingApply(matis->mapping,size_of_constraint,temp_indices_to_constraint+temp_indices[total_counts],gidxs);CHKERRQ(ierr);
2051911cabfeSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
2052911cabfeSStefano Zampini             permutation[j]=j;
2053911cabfeSStefano Zampini           }
2054911cabfeSStefano Zampini           ierr = PetscSortIntWithPermutation(size_of_constraint,gidxs,permutation);CHKERRQ(ierr);
2055911cabfeSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
205608122e43SStefano Zampini             if (permutation[j]!=j) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"This should not happen");
205708122e43SStefano Zampini           }
205808122e43SStefano Zampini           for (j=0;j<size_of_constraint;j++) {
2059911cabfeSStefano Zampini             temp_indices_to_constraint_work[j] = temp_indices_to_constraint[temp_indices[total_counts]+permutation[j]];
2060911cabfeSStefano Zampini             temp_quadrature_constraint_work[j] = temp_quadrature_constraint[temp_indices[total_counts]+permutation[j]];
2061911cabfeSStefano Zampini           }
2062911cabfeSStefano Zampini           ierr = PetscMemcpy(temp_indices_to_constraint+temp_indices[total_counts],temp_indices_to_constraint_work,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
2063911cabfeSStefano Zampini           ierr = PetscMemcpy(temp_quadrature_constraint+temp_indices[total_counts],temp_quadrature_constraint_work,size_of_constraint*sizeof(PetscScalar));CHKERRQ(ierr);
2064911cabfeSStefano Zampini         }
2065674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
2066674ae819SStefano Zampini         total_counts++;
2067674ae819SStefano Zampini       }
2068674ae819SStefano Zampini       for (k=0;k<nnsp_size;k++) {
2069984c4197SStefano Zampini         PetscReal real_value;
2070984c4197SStefano Zampini         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
207139e2fb2aSStefano Zampini         ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
2072674ae819SStefano Zampini         for (j=0;j<size_of_constraint;j++) {
2073984c4197SStefano Zampini           temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
2074674ae819SStefano Zampini         }
2075984c4197SStefano Zampini         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
2076984c4197SStefano Zampini         /* check if array is null on the connected component */
2077e310c8b4SStefano Zampini         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2078e310c8b4SStefano Zampini         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one));
20795b08dc53SStefano Zampini         if (real_value > 0.0) { /* keep indices and values */
2080911cabfeSStefano Zampini           /* sort by global ordering if using lapack subroutines */
20818f1c130eSStefano Zampini           if (!skip_lapack || pcbddc->use_qr_single) {
2082911cabfeSStefano Zampini             ierr = ISLocalToGlobalMappingApply(matis->mapping,size_of_constraint,temp_indices_to_constraint+temp_indices[total_counts],gidxs);CHKERRQ(ierr);
2083911cabfeSStefano Zampini             for (j=0;j<size_of_constraint;j++) {
2084911cabfeSStefano Zampini               permutation[j]=j;
2085911cabfeSStefano Zampini             }
2086911cabfeSStefano Zampini             ierr = PetscSortIntWithPermutation(size_of_constraint,gidxs,permutation);CHKERRQ(ierr);
2087911cabfeSStefano Zampini             for (j=0;j<size_of_constraint;j++) {
2088911cabfeSStefano Zampini               temp_indices_to_constraint_work[j] = temp_indices_to_constraint[temp_indices[total_counts]+permutation[j]];
2089911cabfeSStefano Zampini               temp_quadrature_constraint_work[j] = temp_quadrature_constraint[temp_indices[total_counts]+permutation[j]];
2090911cabfeSStefano Zampini             }
2091911cabfeSStefano Zampini             ierr = PetscMemcpy(temp_indices_to_constraint+temp_indices[total_counts],temp_indices_to_constraint_work,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
2092911cabfeSStefano Zampini             ierr = PetscMemcpy(temp_quadrature_constraint+temp_indices[total_counts],temp_quadrature_constraint_work,size_of_constraint*sizeof(PetscScalar));CHKERRQ(ierr);
2093911cabfeSStefano Zampini           }
2094674ae819SStefano Zampini           temp_constraints++;
2095674ae819SStefano Zampini           temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
2096674ae819SStefano Zampini           total_counts++;
2097674ae819SStefano Zampini         }
2098674ae819SStefano Zampini       }
2099674ae819SStefano Zampini       ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
210045a1bb75SStefano Zampini       valid_constraints = temp_constraints;
2101eb97c9d2SStefano Zampini       if (!pcbddc->use_nnsp_true && temp_constraints) {
2102a773dcb8SStefano Zampini         if (temp_constraints == 1) { /* just normalize the constraint */
2103a773dcb8SStefano Zampini           PetscScalar norm;
2104a773dcb8SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2105a773dcb8SStefano 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));
2106a773dcb8SStefano Zampini           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
2107a773dcb8SStefano Zampini           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,temp_quadrature_constraint+temp_indices[temp_start_ptr],&Blas_one));
2108a773dcb8SStefano Zampini         } else { /* perform SVD */
2109984c4197SStefano Zampini           PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
2110674ae819SStefano Zampini 
2111674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
2112984c4197SStefano Zampini           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
2113984c4197SStefano Zampini              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
2114984c4197SStefano Zampini              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
2115984c4197SStefano Zampini                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
2116984c4197SStefano Zampini                 from that computed using LAPACKgesvd
2117984c4197SStefano Zampini              -> This is due to a different computation of eigenvectors in LAPACKheev
2118984c4197SStefano Zampini              -> The quality of the POD-computed basis will be the same */
2119984c4197SStefano Zampini           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
2120674ae819SStefano Zampini           /* Store upper triangular part of correlation matrix */
2121e310c8b4SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2122984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2123674ae819SStefano Zampini           for (j=0;j<temp_constraints;j++) {
2124674ae819SStefano Zampini             for (k=0;k<j+1;k++) {
2125cf5a6209SStefano 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));
2126674ae819SStefano Zampini             }
2127674ae819SStefano Zampini           }
2128e310c8b4SStefano Zampini           /* compute eigenvalues and eigenvectors of correlation matrix */
2129e310c8b4SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
2130e310c8b4SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
2131674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
2132c8244a33SStefano Zampini           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
2133674ae819SStefano Zampini #else
2134c8244a33SStefano Zampini           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
2135674ae819SStefano Zampini #endif
2136674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2137984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
2138984c4197SStefano Zampini           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
2139674ae819SStefano Zampini           j = 0;
2140984c4197SStefano Zampini           while (j < temp_constraints && singular_vals[j] < tol) j++;
2141674ae819SStefano Zampini           total_counts = total_counts-j;
214245a1bb75SStefano Zampini           valid_constraints = temp_constraints-j;
2143e310c8b4SStefano Zampini           /* scale and copy POD basis into used quadrature memory */
2144c4303822SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
2145c4303822SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
2146c4303822SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
2147c4303822SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2148c4303822SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
2149c4303822SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
2150674ae819SStefano Zampini           if (j<temp_constraints) {
2151984c4197SStefano Zampini             PetscInt ii;
2152984c4197SStefano Zampini             for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
2153674ae819SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2154c4303822SStefano 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));
2155674ae819SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
2156984c4197SStefano Zampini             for (k=0;k<temp_constraints-j;k++) {
2157674ae819SStefano Zampini               for (ii=0;ii<size_of_constraint;ii++) {
2158984c4197SStefano 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];
2159674ae819SStefano Zampini               }
2160674ae819SStefano Zampini             }
2161674ae819SStefano Zampini           }
2162674ae819SStefano Zampini #else  /* on missing GESVD */
2163e310c8b4SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
2164e310c8b4SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
2165b7d8b9f8SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2166674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2167674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
2168cf5a6209SStefano 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));
2169674ae819SStefano Zampini #else
2170cf5a6209SStefano 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));
2171674ae819SStefano Zampini #endif
2172984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
2173674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2174984c4197SStefano Zampini           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
2175e310c8b4SStefano Zampini           k = temp_constraints;
2176e310c8b4SStefano Zampini           if (k > size_of_constraint) k = size_of_constraint;
2177674ae819SStefano Zampini           j = 0;
2178e310c8b4SStefano Zampini           while (j < k && singular_vals[k-j-1] < tol) j++;
217945a1bb75SStefano Zampini           valid_constraints = k-j;
2180911cabfeSStefano Zampini           total_counts = total_counts-temp_constraints+valid_constraints;
2181984c4197SStefano Zampini #endif /* on missing GESVD */
2182674ae819SStefano Zampini         }
2183a773dcb8SStefano Zampini       }
218445a1bb75SStefano Zampini       /* setting change_of_basis flag is safe now */
218545a1bb75SStefano Zampini       if (boolforchange) {
218645a1bb75SStefano Zampini         for (j=0;j<valid_constraints;j++) {
218745a1bb75SStefano Zampini           PetscBTSet(change_basis,total_counts-j-1);
218845a1bb75SStefano Zampini         }
218945a1bb75SStefano Zampini       }
2190674ae819SStefano Zampini     }
2191984c4197SStefano Zampini     /* free workspace */
21928f1c130eSStefano Zampini     if (!skip_lapack || pcbddc->use_qr_single) {
2193911cabfeSStefano Zampini       ierr = PetscFree4(gidxs,permutation,temp_indices_to_constraint_work,temp_quadrature_constraint_work);CHKERRQ(ierr);
21948f1c130eSStefano Zampini     }
21958f1c130eSStefano Zampini     if (!skip_lapack) {
2196984c4197SStefano Zampini       ierr = PetscFree(work);CHKERRQ(ierr);
2197984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
2198984c4197SStefano Zampini       ierr = PetscFree(rwork);CHKERRQ(ierr);
2199984c4197SStefano Zampini #endif
2200984c4197SStefano Zampini       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
2201984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
2202984c4197SStefano Zampini       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
2203984c4197SStefano Zampini       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
2204984c4197SStefano Zampini #endif
2205984c4197SStefano Zampini     }
2206984c4197SStefano Zampini     for (k=0;k<nnsp_size;k++) {
2207984c4197SStefano Zampini       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
2208984c4197SStefano Zampini     }
2209984c4197SStefano Zampini     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
2210cf5a6209SStefano Zampini     /* free index sets of faces, edges and vertices */
2211cf5a6209SStefano Zampini     for (i=0;i<n_ISForFaces;i++) {
2212cf5a6209SStefano Zampini       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
2213cf5a6209SStefano Zampini     }
2214cf5a6209SStefano Zampini     if (n_ISForFaces) {
2215cf5a6209SStefano Zampini       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
2216cf5a6209SStefano Zampini     }
2217cf5a6209SStefano Zampini     for (i=0;i<n_ISForEdges;i++) {
2218cf5a6209SStefano Zampini       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
2219cf5a6209SStefano Zampini     }
2220cf5a6209SStefano Zampini     if (n_ISForEdges) {
2221cf5a6209SStefano Zampini       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
2222cf5a6209SStefano Zampini     }
2223cf5a6209SStefano Zampini     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
222408122e43SStefano Zampini   } else {
222508122e43SStefano Zampini     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
222608122e43SStefano Zampini     PetscInt        cum = 0;
222708122e43SStefano Zampini 
222808122e43SStefano Zampini     total_counts = 0;
222908122e43SStefano Zampini     n_vertices = 0;
22308bec7fa6SStefano Zampini     if (sub_schurs->is_Ej_com && pcbddc->use_vertices) {
223108122e43SStefano Zampini       ierr = ISGetLocalSize(sub_schurs->is_Ej_com,&n_vertices);CHKERRQ(ierr);
223208122e43SStefano Zampini     }
223308122e43SStefano Zampini     max_constraints = 0;
223408122e43SStefano Zampini     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
223508122e43SStefano Zampini       total_counts += pcbddc->adaptive_constraints_n[i];
223608122e43SStefano Zampini       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
223708122e43SStefano Zampini     }
223808122e43SStefano Zampini     temp_indices = pcbddc->adaptive_constraints_ptrs;
223908122e43SStefano Zampini     temp_indices_to_constraint = pcbddc->adaptive_constraints_idxs;
224008122e43SStefano Zampini     temp_quadrature_constraint = pcbddc->adaptive_constraints_data;
224108122e43SStefano Zampini 
224208122e43SStefano Zampini #if 0
224308122e43SStefano Zampini     printf("Found %d totals\n",total_counts);
224408122e43SStefano Zampini     for (i=0;i<total_counts;i++) {
224508122e43SStefano Zampini       printf("const %d, start %d",i,temp_indices[i]);
224608122e43SStefano Zampini       printf(" end %d:\n",temp_indices[i+1]);
224708122e43SStefano Zampini       for (j=temp_indices[i];j<temp_indices[i+1];j++) {
224808122e43SStefano Zampini         printf("  idxs %d",temp_indices_to_constraint[j]);
224908122e43SStefano Zampini         printf("  data %1.2e\n",temp_quadrature_constraint[j]);
225008122e43SStefano Zampini       }
225108122e43SStefano Zampini     }
22521b968477SStefano Zampini     for (i=0;i<n_vertices;i++) {
22538bec7fa6SStefano Zampini       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
22541b968477SStefano Zampini     }
22551b968477SStefano Zampini     for (i=0;i<sub_schurs->n_subs;i++) {
22568bec7fa6SStefano 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]);
22571b968477SStefano Zampini     }
225808122e43SStefano Zampini #endif
225908122e43SStefano Zampini 
22608bec7fa6SStefano Zampini     max_size_of_constraint = 0;
226108122e43SStefano Zampini     for (i=0;i<total_counts;i++) max_size_of_constraint = PetscMax(max_size_of_constraint,temp_indices[i+1]-temp_indices[i]);
226208122e43SStefano Zampini     ierr = PetscMalloc1(temp_indices[total_counts],&temp_indices_to_constraint_B);CHKERRQ(ierr);
226308122e43SStefano Zampini     /* Change of basis */
226408122e43SStefano Zampini     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
226508122e43SStefano Zampini     if (pcbddc->use_change_of_basis) {
2266bbb9e6c6SStefano Zampini       cum = n_vertices;
226708122e43SStefano Zampini       for (i=0;i<sub_schurs->n_subs;i++) {
226808122e43SStefano Zampini         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
2269bbb9e6c6SStefano Zampini           for (j=0;j<pcbddc->adaptive_constraints_n[i+n_vertices];j++) {
227008122e43SStefano Zampini             ierr = PetscBTSet(change_basis,cum+j);CHKERRQ(ierr);
227108122e43SStefano Zampini           }
227208122e43SStefano Zampini         }
2273bbb9e6c6SStefano Zampini         cum += pcbddc->adaptive_constraints_n[i+n_vertices];
227408122e43SStefano Zampini       }
227508122e43SStefano Zampini     }
227608122e43SStefano Zampini   }
227708122e43SStefano Zampini 
227808122e43SStefano Zampini   /* map temp_indices_to_constraint in boundary numbering */
227908122e43SStefano Zampini   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,temp_indices[total_counts],temp_indices_to_constraint,&i,temp_indices_to_constraint_B);CHKERRQ(ierr);
228008122e43SStefano Zampini   if (i != temp_indices[total_counts]) {
228108122e43SStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for constraints indices %d != %d\n",temp_indices[total_counts],i);
228208122e43SStefano Zampini   }
2283984c4197SStefano Zampini 
2284727cdba6SStefano Zampini   /* set quantities in pcbddc data structure and store previous primal size */
2285984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
2286674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
2287727cdba6SStefano Zampini   olocal_primal_size = pcbddc->local_primal_size;
2288984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
2289674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
2290984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
2291674ae819SStefano Zampini 
2292674ae819SStefano Zampini   /* Create constraint matrix */
2293674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
2294674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
2295674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
229616f15bc4SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
2297984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
2298984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
2299785e854fSJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&aux_primal_numbering);CHKERRQ(ierr);
2300984c4197SStefano Zampini   /* array to select the proper local node (of minimum index with respect to global ordering) when changing the basis */
2301984c4197SStefano Zampini   /* note: it should not be needed since IS for faces and edges are already sorted by global ordering when analyzing the graph but... just in case */
2302785e854fSJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&aux_primal_minloc);CHKERRQ(ierr);
2303984c4197SStefano Zampini   /* auxiliary stuff for basis change */
2304785e854fSJed Brown   ierr = PetscMalloc1(max_size_of_constraint,&global_indices);CHKERRQ(ierr);
23054641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n_B,&touched);CHKERRQ(ierr);
2306984c4197SStefano Zampini 
2307984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
2308984c4197SStefano Zampini   total_primal_vertices=0;
2309984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
2310674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
2311984c4197SStefano Zampini     if (size_of_constraint == 1) {
23124641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]]);CHKERRQ(ierr);
2313984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]];
2314984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=0;
2315984c4197SStefano Zampini       total_primal_vertices++;
23164641a718SStefano Zampini     } else if (PetscBTLookup(change_basis,i)) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */
2317984c4197SStefano Zampini       PetscInt min_loc,min_index;
2318984c4197SStefano Zampini       ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],global_indices);CHKERRQ(ierr);
2319984c4197SStefano Zampini       /* find first untouched local node */
2320674ae819SStefano Zampini       k = 0;
23214641a718SStefano Zampini       while (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) k++;
2322984c4197SStefano Zampini       min_index = global_indices[k];
2323984c4197SStefano Zampini       min_loc = k;
2324984c4197SStefano Zampini       /* search the minimum among global nodes already untouched on the cc */
2325984c4197SStefano Zampini       for (k=1;k<size_of_constraint;k++) {
2326984c4197SStefano Zampini         /* there can be more than one constraint on a single connected component */
23274641a718SStefano Zampini         if (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k]) && min_index > global_indices[k]) {
2328984c4197SStefano Zampini           min_index = global_indices[k];
2329984c4197SStefano Zampini           min_loc = k;
2330674ae819SStefano Zampini         }
2331674ae819SStefano Zampini       }
23324641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+min_loc]);CHKERRQ(ierr);
2333984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]+min_loc];
2334984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=min_loc;
2335984c4197SStefano Zampini       total_primal_vertices++;
2336984c4197SStefano Zampini     }
2337984c4197SStefano Zampini   }
2338a717540cSStefano Zampini   /* determine if a QR strategy is needed for change of basis */
2339a717540cSStefano Zampini   qr_needed = PETSC_FALSE;
2340a717540cSStefano Zampini   ierr = PetscBTCreate(pcbddc->local_primal_size,&qr_needed_idx);CHKERRQ(ierr);
2341a717540cSStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
2342a717540cSStefano Zampini     if (PetscBTLookup(change_basis,i)) {
2343fa434743SStefano Zampini       if (!pcbddc->use_qr_single) {
2344a717540cSStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
2345a717540cSStefano Zampini         j = 0;
2346a717540cSStefano Zampini         for (k=0;k<size_of_constraint;k++) {
2347a717540cSStefano Zampini           if (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) {
2348a717540cSStefano Zampini             j++;
2349a717540cSStefano Zampini           }
2350a717540cSStefano Zampini         }
2351a717540cSStefano Zampini         /* found more than one primal dof on the cc */
2352a717540cSStefano Zampini         if (j > 1) {
2353a717540cSStefano Zampini           PetscBTSet(qr_needed_idx,i);
2354a717540cSStefano Zampini           qr_needed = PETSC_TRUE;
2355a717540cSStefano Zampini         }
2356fa434743SStefano Zampini       } else {
2357fa434743SStefano Zampini         PetscBTSet(qr_needed_idx,i);
2358fa434743SStefano Zampini         qr_needed = PETSC_TRUE;
2359fa434743SStefano Zampini       }
2360a717540cSStefano Zampini     }
2361a717540cSStefano Zampini   }
2362984c4197SStefano Zampini   /* free workspace */
2363984c4197SStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
236445a1bb75SStefano Zampini 
2365674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
2366a717540cSStefano Zampini   ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering);CHKERRQ(ierr);
2367984c4197SStefano Zampini 
2368984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
2369785e854fSJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
2370984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
2371984c4197SStefano Zampini   j=total_primal_vertices;
2372984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
23734641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
2374674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
2375674ae819SStefano Zampini       j++;
2376674ae819SStefano Zampini     }
2377674ae819SStefano Zampini   }
2378674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
2379674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
2380674ae819SStefano Zampini   /* set values in constraint matrix */
2381984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
2382984c4197SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
2383674ae819SStefano Zampini   }
2384984c4197SStefano Zampini   total_counts = total_primal_vertices;
2385984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
23864641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
2387674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
2388674ae819SStefano 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);
2389674ae819SStefano Zampini       total_counts++;
2390674ae819SStefano Zampini     }
2391674ae819SStefano Zampini   }
2392674ae819SStefano Zampini   /* assembling */
2393674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2394674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2395984c4197SStefano Zampini   /*
239645a1bb75SStefano Zampini   ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
2397984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
2398984c4197SStefano Zampini   */
2399674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
2400674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
2401026de310SStefano Zampini     /* dual and primal dofs on a single cc */
2402984c4197SStefano Zampini     PetscInt     dual_dofs,primal_dofs;
2403026de310SStefano Zampini     /* iterator on aux_primal_minloc (ordered as read from nearnullspace: vertices, edges and then constraints) */
2404026de310SStefano Zampini     PetscInt     primal_counter;
2405984c4197SStefano Zampini     /* working stuff for GEQRF */
240681d9aea3SBarry Smith     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
2407984c4197SStefano Zampini     PetscBLASInt lqr_work;
2408984c4197SStefano Zampini     /* working stuff for UNGQR */
2409984c4197SStefano Zampini     PetscScalar  *gqr_work,lgqr_work_t;
2410984c4197SStefano Zampini     PetscBLASInt lgqr_work;
2411984c4197SStefano Zampini     /* working stuff for TRTRS */
2412984c4197SStefano Zampini     PetscScalar  *trs_rhs;
24133f08241aSStefano Zampini     PetscBLASInt Blas_NRHS;
2414984c4197SStefano Zampini     /* pointers for values insertion into change of basis matrix */
2415984c4197SStefano Zampini     PetscInt     *start_rows,*start_cols;
2416984c4197SStefano Zampini     PetscScalar  *start_vals;
2417984c4197SStefano Zampini     /* working stuff for values insertion */
24184641a718SStefano Zampini     PetscBT      is_primal;
2419906d46d4SStefano Zampini     /* matrix sizes */
2420906d46d4SStefano Zampini     PetscInt     global_size,local_size;
2421906d46d4SStefano Zampini     /* temporary change of basis */
2422906d46d4SStefano Zampini     Mat          localChangeOfBasisMatrix;
2423cf5a6209SStefano Zampini     /* extra space for debugging */
2424cf5a6209SStefano Zampini     PetscScalar  *dbg_work;
2425984c4197SStefano Zampini 
2426906d46d4SStefano Zampini     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
2427906d46d4SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
242816f15bc4SStefano Zampini     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
2429bbb9e6c6SStefano Zampini     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
2430906d46d4SStefano Zampini     /* nonzeros for local mat */
2431bbb9e6c6SStefano Zampini     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
2432bbb9e6c6SStefano Zampini     for (i=0;i<pcis->n;i++) nnz[i]=1;
2433a717540cSStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
2434a717540cSStefano Zampini       if (PetscBTLookup(change_basis,i)) {
2435a717540cSStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
2436a717540cSStefano Zampini         if (PetscBTLookup(qr_needed_idx,i)) {
2437bbb9e6c6SStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint[temp_indices[i]+j]] = size_of_constraint;
2438a717540cSStefano Zampini         } else {
2439bbb9e6c6SStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint[temp_indices[i]+j]] = 2;
2440a717540cSStefano Zampini           /* get local primal index on the cc */
2441a717540cSStefano Zampini           j = 0;
2442a717540cSStefano Zampini           while (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+j])) j++;
2443bbb9e6c6SStefano Zampini           nnz[temp_indices_to_constraint[temp_indices[i]+j]] = size_of_constraint;
2444a717540cSStefano Zampini         }
2445a717540cSStefano Zampini       }
2446a717540cSStefano Zampini     }
2447906d46d4SStefano Zampini     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
2448bbb9e6c6SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
2449a717540cSStefano Zampini     /* Set initial identity in the matrix */
2450bbb9e6c6SStefano Zampini     for (i=0;i<pcis->n;i++) {
2451906d46d4SStefano Zampini       ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
2452a717540cSStefano Zampini     }
2453a717540cSStefano Zampini 
2454a717540cSStefano Zampini     if (pcbddc->dbg_flag) {
2455a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
2456a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
2457a717540cSStefano Zampini     }
2458a717540cSStefano Zampini 
2459a717540cSStefano Zampini 
2460a717540cSStefano Zampini     /* Now we loop on the constraints which need a change of basis */
2461a717540cSStefano Zampini     /*
2462a717540cSStefano Zampini        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
2463a717540cSStefano Zampini        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
2464a717540cSStefano Zampini 
2465a6b551f4SStefano Zampini        Basic blocks of change of basis matrix T computed by
2466a717540cSStefano Zampini 
2467a6b551f4SStefano 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)
2468a6b551f4SStefano Zampini 
2469a6b551f4SStefano Zampini             | 1        0   ...        0         s_1/S |
2470a6b551f4SStefano Zampini             | 0        1   ...        0         s_2/S |
2471a717540cSStefano Zampini             |              ...                        |
2472a6b551f4SStefano Zampini             | 0        ...            1     s_{n-1}/S |
2473a6b551f4SStefano Zampini             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
2474a717540cSStefano Zampini 
2475a6b551f4SStefano Zampini             with S = \sum_{i=1}^n s_i^2
2476a6b551f4SStefano Zampini             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
2477a6b551f4SStefano Zampini                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
2478a6b551f4SStefano Zampini 
2479a6b551f4SStefano Zampini           - QR decomposition of constraints otherwise
2480a717540cSStefano Zampini     */
2481a717540cSStefano Zampini     if (qr_needed) {
2482984c4197SStefano Zampini       /* space to store Q */
2483854ce69bSBarry Smith       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
2484984c4197SStefano Zampini       /* first we issue queries for optimal work */
24853f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
24863f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
24873f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2488984c4197SStefano Zampini       lqr_work = -1;
24893f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
2490984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
2491984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
2492785e854fSJed Brown       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
2493984c4197SStefano Zampini       lgqr_work = -1;
24943f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
24953f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
24963f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
24973f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
24983f08241aSStefano Zampini       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
24993f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
2500984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
2501984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
2502785e854fSJed Brown       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
2503984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
2504785e854fSJed Brown       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
2505984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
2506785e854fSJed Brown       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
2507a717540cSStefano Zampini       /* allocating workspace for check */
2508a717540cSStefano Zampini       if (pcbddc->dbg_flag) {
2509cf5a6209SStefano Zampini         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
2510a717540cSStefano Zampini       }
2511a717540cSStefano Zampini     }
2512984c4197SStefano Zampini     /* array to store whether a node is primal or not */
25134641a718SStefano Zampini     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
2514473ba861SJed Brown     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
25155e8657edSStefano Zampini     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,aux_primal_numbering,&i,aux_primal_numbering_B);CHKERRQ(ierr);
251639e2fb2aSStefano Zampini     if (i != total_primal_vertices) {
251739e2fb2aSStefano Zampini       SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",total_primal_vertices,i);
25184641a718SStefano Zampini     }
251939e2fb2aSStefano Zampini     for (i=0;i<total_primal_vertices;i++) {
252039e2fb2aSStefano Zampini       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
252139e2fb2aSStefano Zampini     }
252239e2fb2aSStefano Zampini     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
2523984c4197SStefano Zampini 
2524a717540cSStefano Zampini     /* loop on constraints and see whether or not they need a change of basis and compute it */
2525026de310SStefano Zampini     /* -> using implicit ordering contained in temp_indices data */
2526026de310SStefano Zampini     total_counts = pcbddc->n_vertices;
2527026de310SStefano Zampini     primal_counter = total_counts;
2528026de310SStefano Zampini     while (total_counts<pcbddc->local_primal_size) {
2529026de310SStefano Zampini       primal_dofs = 1;
25304641a718SStefano Zampini       if (PetscBTLookup(change_basis,total_counts)) {
2531026de310SStefano Zampini         /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
2532bbb9e6c6SStefano 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]]) {
2533026de310SStefano Zampini           primal_dofs++;
2534674ae819SStefano Zampini         }
2535984c4197SStefano Zampini         /* get constraint info */
2536026de310SStefano Zampini         size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
2537984c4197SStefano Zampini         dual_dofs = size_of_constraint-primal_dofs;
2538984c4197SStefano Zampini 
2539984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
2540a717540cSStefano 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);
2541674ae819SStefano Zampini         }
2542984c4197SStefano Zampini 
2543fa434743SStefano Zampini         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
2544a717540cSStefano Zampini 
2545a717540cSStefano Zampini           /* copy quadrature constraints for change of basis check */
2546a717540cSStefano Zampini           if (pcbddc->dbg_flag) {
2547cf5a6209SStefano Zampini             ierr = PetscMemcpy(dbg_work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
2548a717540cSStefano Zampini           }
2549984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
2550026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
2551984c4197SStefano Zampini 
2552984c4197SStefano Zampini           /* compute QR decomposition of constraints */
25533f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
25543f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
25553f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2556674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
25573f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
2558984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
2559674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2560984c4197SStefano Zampini 
2561984c4197SStefano Zampini           /* explictly compute R^-T */
2562984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
2563984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
25643f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
25653f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
25663f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
25673f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
2568984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
25693f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
2570984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
2571984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2572984c4197SStefano Zampini 
2573a717540cSStefano Zampini           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
25743f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
25753f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
25763f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
25773f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2578984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
25793f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
2580984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
2581984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2582984c4197SStefano Zampini 
2583984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
2584984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
2585984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
25863f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
25873f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
25883f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
25893f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
25903f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
25913f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
2592984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2593c4303822SStefano 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));
2594984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2595026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
2596984c4197SStefano Zampini 
2597984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
2598bbb9e6c6SStefano Zampini           start_rows = &temp_indices_to_constraint[temp_indices[total_counts]];
2599984c4197SStefano Zampini           /* insert cols for primal dofs */
2600984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
2601984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
2602bbb9e6c6SStefano Zampini             start_cols = &temp_indices_to_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter+j]];
2603906d46d4SStefano Zampini             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
2604984c4197SStefano Zampini           }
2605984c4197SStefano Zampini           /* insert cols for dual dofs */
2606984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
26074641a718SStefano Zampini             if (!PetscBTLookup(is_primal,temp_indices_to_constraint_B[temp_indices[total_counts]+k])) {
2608984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
2609bbb9e6c6SStefano Zampini               start_cols = &temp_indices_to_constraint[temp_indices[total_counts]+k];
2610906d46d4SStefano Zampini               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
2611984c4197SStefano Zampini               j++;
2612674ae819SStefano Zampini             }
2613674ae819SStefano Zampini           }
2614984c4197SStefano Zampini 
2615984c4197SStefano Zampini           /* check change of basis */
2616984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
2617984c4197SStefano Zampini             PetscInt   ii,jj;
2618984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
2619c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
2620c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2621c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
2622c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2623c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
2624c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
2625984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2626cf5a6209SStefano 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));
2627984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
2628984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
2629984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
2630cf5a6209SStefano Zampini                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
2631cf5a6209SStefano 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;
2632674ae819SStefano Zampini               }
2633674ae819SStefano Zampini             }
2634984c4197SStefano Zampini             if (!valid_qr) {
263522d5777bSStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
2636984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
2637984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
2638cf5a6209SStefano Zampini                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
2639cf5a6209SStefano 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]));
2640674ae819SStefano Zampini                   }
2641cf5a6209SStefano Zampini                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
2642cf5a6209SStefano 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]));
2643984c4197SStefano Zampini                   }
2644984c4197SStefano Zampini                 }
2645984c4197SStefano Zampini               }
2646674ae819SStefano Zampini             } else {
264722d5777bSStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
2648674ae819SStefano Zampini             }
2649674ae819SStefano Zampini           }
2650a717540cSStefano Zampini         } else { /* simple transformation block */
2651a717540cSStefano Zampini           PetscInt    row,col;
2652a6b551f4SStefano Zampini           PetscScalar val,norm;
2653a6b551f4SStefano Zampini 
2654a6b551f4SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2655a6b551f4SStefano 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));
2656a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
2657bbb9e6c6SStefano Zampini             PetscInt row_B = temp_indices_to_constraint_B[temp_indices[total_counts]+j];
2658bbb9e6c6SStefano Zampini             row = temp_indices_to_constraint[temp_indices[total_counts]+j];
2659bbb9e6c6SStefano Zampini             if (!PetscBTLookup(is_primal,row_B)) {
2660bbb9e6c6SStefano Zampini               col = temp_indices_to_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
2661906d46d4SStefano Zampini               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
2662a6b551f4SStefano Zampini               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,temp_quadrature_constraint[temp_indices[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
2663a717540cSStefano Zampini             } else {
2664a717540cSStefano Zampini               for (k=0;k<size_of_constraint;k++) {
2665bbb9e6c6SStefano Zampini                 col = temp_indices_to_constraint[temp_indices[total_counts]+k];
2666a717540cSStefano Zampini                 if (row != col) {
2667a717540cSStefano Zampini                   val = -temp_quadrature_constraint[temp_indices[total_counts]+k]/temp_quadrature_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
2668a717540cSStefano Zampini                 } else {
2669a6b551f4SStefano Zampini                   val = temp_quadrature_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter]]/norm;
2670a717540cSStefano Zampini                 }
2671906d46d4SStefano Zampini                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
2672a717540cSStefano Zampini               }
2673a717540cSStefano Zampini             }
2674a717540cSStefano Zampini           }
267598a51de6SStefano Zampini           if (pcbddc->dbg_flag) {
267622d5777bSStefano Zampini             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
2677a717540cSStefano Zampini           }
2678674ae819SStefano Zampini         }
2679026de310SStefano Zampini         /* increment primal counter */
2680026de310SStefano Zampini         primal_counter += primal_dofs;
2681984c4197SStefano Zampini       } else {
2682984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
2683026de310SStefano 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);
2684674ae819SStefano Zampini         }
2685674ae819SStefano Zampini       }
2686026de310SStefano Zampini       /* increment constraint counter total_counts */
2687026de310SStefano Zampini       total_counts += primal_dofs;
2688674ae819SStefano Zampini     }
2689a717540cSStefano Zampini 
2690a717540cSStefano Zampini     /* free workspace */
2691a717540cSStefano Zampini     if (qr_needed) {
2692984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
2693cf5a6209SStefano Zampini         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
2694984c4197SStefano Zampini       }
2695984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
2696984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
2697984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
2698984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
2699984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
2700674ae819SStefano Zampini     }
2701a717540cSStefano Zampini     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
2702906d46d4SStefano Zampini     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2703906d46d4SStefano Zampini     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2704906d46d4SStefano Zampini 
2705906d46d4SStefano Zampini     /* assembling of global change of variable */
2706bbb9e6c6SStefano Zampini     {
2707bbb9e6c6SStefano Zampini       Mat      tmat;
270816f15bc4SStefano Zampini       PetscInt bs;
270916f15bc4SStefano Zampini 
2710906d46d4SStefano Zampini       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
2711906d46d4SStefano Zampini       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
2712bbb9e6c6SStefano Zampini       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
2713bbb9e6c6SStefano Zampini       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
2714bbb9e6c6SStefano Zampini       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
2715bbb9e6c6SStefano Zampini       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
271616f15bc4SStefano Zampini       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
271716f15bc4SStefano Zampini       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
2718906d46d4SStefano Zampini       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
2719bbb9e6c6SStefano Zampini       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
2720bbb9e6c6SStefano Zampini       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
2721bbb9e6c6SStefano Zampini       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
2722bbb9e6c6SStefano Zampini       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
2723bbb9e6c6SStefano Zampini       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
2724bbb9e6c6SStefano Zampini       ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2725bbb9e6c6SStefano Zampini       ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2726bbb9e6c6SStefano Zampini       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
2727bbb9e6c6SStefano Zampini       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
2728906d46d4SStefano Zampini     }
2729906d46d4SStefano Zampini     /* check */
2730906d46d4SStefano Zampini     if (pcbddc->dbg_flag) {
2731906d46d4SStefano Zampini       PetscReal error;
2732906d46d4SStefano Zampini       Vec       x,x_change;
2733906d46d4SStefano Zampini 
2734906d46d4SStefano Zampini       ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
2735906d46d4SStefano Zampini       ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
2736906d46d4SStefano Zampini       ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
2737906d46d4SStefano Zampini       ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
2738bbb9e6c6SStefano Zampini       ierr = VecScatterBegin(matis->ctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2739bbb9e6c6SStefano Zampini       ierr = VecScatterEnd(matis->ctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2740bbb9e6c6SStefano Zampini       ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
2741bbb9e6c6SStefano Zampini       ierr = VecScatterBegin(matis->ctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2742bbb9e6c6SStefano Zampini       ierr = VecScatterEnd(matis->ctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2743906d46d4SStefano Zampini       ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
2744906d46d4SStefano Zampini       ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
2745906d46d4SStefano Zampini       ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
2746906d46d4SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2747bbb9e6c6SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Error global vs local change: %1.6e\n",error);CHKERRQ(ierr);
2748906d46d4SStefano Zampini       ierr = VecDestroy(&x);CHKERRQ(ierr);
2749906d46d4SStefano Zampini       ierr = VecDestroy(&x_change);CHKERRQ(ierr);
2750906d46d4SStefano Zampini     }
2751b96c3477SStefano Zampini 
2752b96c3477SStefano Zampini     /* adapt sub_schurs computed (if any) */
2753b96c3477SStefano Zampini     if (pcbddc->use_deluxe_scaling) {
2754b96c3477SStefano Zampini       PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
2755b96c3477SStefano Zampini       if (sub_schurs->S_Ej_all) {
2756b96c3477SStefano Zampini         Mat S_1,S_2,tmat;
2757bbb9e6c6SStefano Zampini         IS is_all_N;
2758bbb9e6c6SStefano Zampini 
2759bbb9e6c6SStefano Zampini         ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
2760d648f858SStefano Zampini         ierr = MatGetSubMatrixUnsorted(localChangeOfBasisMatrix,is_all_N,is_all_N,&tmat);CHKERRQ(ierr);
2761bbb9e6c6SStefano Zampini         ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
2762b96c3477SStefano Zampini         ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_1);CHKERRQ(ierr);
2763b96c3477SStefano Zampini         ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
2764b96c3477SStefano Zampini         sub_schurs->S_Ej_all = S_1;
2765b96c3477SStefano Zampini         ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_2);CHKERRQ(ierr);
2766b96c3477SStefano Zampini         ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
2767b96c3477SStefano Zampini         sub_schurs->sum_S_Ej_all = S_2;
2768b96c3477SStefano Zampini         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
2769b96c3477SStefano Zampini       }
2770b96c3477SStefano Zampini     }
2771906d46d4SStefano Zampini     ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
2772906d46d4SStefano Zampini   } else if (pcbddc->user_ChangeOfBasisMatrix) {
2773b9b85e73SStefano Zampini     ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
2774b9b85e73SStefano Zampini     pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
2775b9b85e73SStefano Zampini   }
2776906d46d4SStefano Zampini 
2777906d46d4SStefano Zampini   /* set up change of basis context */
2778906d46d4SStefano Zampini   if (pcbddc->ChangeOfBasisMatrix) {
2779906d46d4SStefano Zampini     PCBDDCChange_ctx change_ctx;
2780906d46d4SStefano Zampini 
2781906d46d4SStefano Zampini     if (!pcbddc->new_global_mat) {
2782906d46d4SStefano Zampini       PetscInt global_size,local_size;
2783906d46d4SStefano Zampini 
2784906d46d4SStefano Zampini       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
2785906d46d4SStefano Zampini       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
2786906d46d4SStefano Zampini       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->new_global_mat);CHKERRQ(ierr);
2787906d46d4SStefano Zampini       ierr = MatSetSizes(pcbddc->new_global_mat,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
2788906d46d4SStefano Zampini       ierr = MatSetType(pcbddc->new_global_mat,MATSHELL);CHKERRQ(ierr);
2789906d46d4SStefano Zampini       ierr = MatShellSetOperation(pcbddc->new_global_mat,MATOP_MULT,(void (*)(void))PCBDDCMatMult_Private);CHKERRQ(ierr);
2790906d46d4SStefano Zampini       ierr = MatShellSetOperation(pcbddc->new_global_mat,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCMatMultTranspose_Private);CHKERRQ(ierr);
2791906d46d4SStefano Zampini       ierr = PetscNew(&change_ctx);CHKERRQ(ierr);
2792906d46d4SStefano Zampini       ierr = MatShellSetContext(pcbddc->new_global_mat,change_ctx);CHKERRQ(ierr);
2793906d46d4SStefano Zampini     } else {
2794906d46d4SStefano Zampini       ierr = MatShellGetContext(pcbddc->new_global_mat,&change_ctx);CHKERRQ(ierr);
2795906d46d4SStefano Zampini       ierr = MatDestroy(&change_ctx->global_change);CHKERRQ(ierr);
2796906d46d4SStefano Zampini       ierr = VecDestroyVecs(2,&change_ctx->work);CHKERRQ(ierr);
2797906d46d4SStefano Zampini     }
2798906d46d4SStefano Zampini     if (!pcbddc->user_ChangeOfBasisMatrix) {
2799906d46d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
2800906d46d4SStefano Zampini       change_ctx->global_change = pcbddc->ChangeOfBasisMatrix;
2801906d46d4SStefano Zampini     } else {
2802906d46d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
2803906d46d4SStefano Zampini       change_ctx->global_change = pcbddc->user_ChangeOfBasisMatrix;
2804906d46d4SStefano Zampini     }
2805906d46d4SStefano Zampini     ierr = VecDuplicateVecs(pcis->vec1_global,2,&change_ctx->work);CHKERRQ(ierr);
2806906d46d4SStefano Zampini     ierr = MatSetUp(pcbddc->new_global_mat);CHKERRQ(ierr);
2807906d46d4SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->new_global_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2808906d46d4SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->new_global_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2809b9b85e73SStefano Zampini   }
2810a717540cSStefano Zampini 
2811727cdba6SStefano Zampini   /* get indices in local ordering for vertices and constraints */
2812727cdba6SStefano Zampini   if (olocal_primal_size == pcbddc->local_primal_size) { /* if this is true, I need to check if a new primal space has been introduced */
2813473ba861SJed Brown     ierr = PetscMalloc1(olocal_primal_size,&oprimal_indices_local_idxs);CHKERRQ(ierr);
2814727cdba6SStefano Zampini     ierr = PetscMemcpy(oprimal_indices_local_idxs,pcbddc->primal_indices_local_idxs,olocal_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
2815727cdba6SStefano Zampini   }
2816727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2817f347579bSStefano Zampini   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
2818473ba861SJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
2819727cdba6SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_primal_numbering);CHKERRQ(ierr);
2820727cdba6SStefano Zampini   ierr = PetscMemcpy(pcbddc->primal_indices_local_idxs,aux_primal_numbering,i*sizeof(PetscInt));CHKERRQ(ierr);
2821727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2822727cdba6SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_primal_numbering);CHKERRQ(ierr);
2823727cdba6SStefano Zampini   ierr = PetscMemcpy(&pcbddc->primal_indices_local_idxs[i],aux_primal_numbering,j*sizeof(PetscInt));CHKERRQ(ierr);
2824727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2825e9189074SStefano Zampini   /* set quantities in PCBDDC data struct */
2826e9189074SStefano Zampini   pcbddc->n_actual_vertices = i;
2827727cdba6SStefano Zampini   /* check if a new primal space has been introduced */
2828727cdba6SStefano Zampini   pcbddc->new_primal_space_local = PETSC_TRUE;
2829727cdba6SStefano Zampini   if (olocal_primal_size == pcbddc->local_primal_size) {
2830727cdba6SStefano Zampini     ierr = PetscMemcmp(pcbddc->primal_indices_local_idxs,oprimal_indices_local_idxs,olocal_primal_size,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
2831c1c8e736SStefano Zampini     pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
2832727cdba6SStefano Zampini     ierr = PetscFree(oprimal_indices_local_idxs);CHKERRQ(ierr);
2833727cdba6SStefano Zampini   }
2834727cdba6SStefano Zampini   /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
2835727cdba6SStefano Zampini   ierr = MPI_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2836727cdba6SStefano Zampini 
2837a717540cSStefano Zampini   /* flush dbg viewer */
2838b8ffe317SStefano Zampini   if (pcbddc->dbg_flag) {
2839b8ffe317SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2840b8ffe317SStefano Zampini   }
2841a717540cSStefano Zampini 
2842e310c8b4SStefano Zampini   /* free workspace */
2843a717540cSStefano Zampini   ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2844a717540cSStefano Zampini   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
2845984c4197SStefano Zampini   ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr);
28464641a718SStefano Zampini   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
284708122e43SStefano Zampini   if (!pcbddc->adaptive_selection) {
2848906d46d4SStefano Zampini     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
2849906d46d4SStefano Zampini     ierr = PetscFree3(temp_quadrature_constraint,temp_indices_to_constraint,temp_indices_to_constraint_B);CHKERRQ(ierr);
285008122e43SStefano Zampini   } else {
285108122e43SStefano Zampini     ierr = PetscFree4(pcbddc->adaptive_constraints_n,
285208122e43SStefano Zampini                       pcbddc->adaptive_constraints_ptrs,
285308122e43SStefano Zampini                       pcbddc->adaptive_constraints_idxs,
285408122e43SStefano Zampini                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
285508122e43SStefano Zampini     ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
285608122e43SStefano Zampini   }
2857674ae819SStefano Zampini   PetscFunctionReturn(0);
2858674ae819SStefano Zampini }
2859674ae819SStefano Zampini 
2860674ae819SStefano Zampini #undef __FUNCT__
2861674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
2862674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
2863674ae819SStefano Zampini {
2864674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
2865674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
2866674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
286763602bcaSStefano Zampini   PetscInt    ierr,i,vertex_size;
2868674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
2869674ae819SStefano Zampini 
2870674ae819SStefano Zampini   PetscFunctionBegin;
28718e61c736SStefano Zampini   /* Reset previously computed graph */
28728e61c736SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
2873674ae819SStefano Zampini   /* Init local Graph struct */
2874674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
2875674ae819SStefano Zampini 
2876575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
2877575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
2878575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
2879575ad6abSStefano Zampini   }
28809577ea80SStefano Zampini 
2881674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
28824d379d7bSStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
28834d379d7bSStefano Zampini     PetscInt  *xadj,*adjncy;
28844d379d7bSStefano Zampini     PetscInt  nvtxs;
2885e496cd5dSStefano Zampini     PetscBool flg_row=PETSC_FALSE;
2886674ae819SStefano Zampini 
28874d379d7bSStefano Zampini     if (pcbddc->use_local_adj) {
28882fffb893SStefano Zampini 
28892fffb893SStefano Zampini       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
28902fffb893SStefano Zampini       if (flg_row) {
28914d379d7bSStefano Zampini         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
2892b96c3477SStefano Zampini         pcbddc->computed_rowadj = PETSC_TRUE;
28932fffb893SStefano Zampini       }
28942fffb893SStefano Zampini       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
28952fffb893SStefano Zampini     } else if (pcbddc->current_level) { /* just compute subdomain's connected components for coarser levels */
28964d379d7bSStefano Zampini       IS                     is_dummy;
28974d379d7bSStefano Zampini       ISLocalToGlobalMapping l2gmap_dummy;
28984d379d7bSStefano Zampini       PetscInt               j,sum;
28994d379d7bSStefano Zampini       PetscInt               *cxadj,*cadjncy;
29004d379d7bSStefano Zampini       const PetscInt         *idxs;
29014d379d7bSStefano Zampini       PCBDDCGraph            graph;
29024d379d7bSStefano Zampini       PetscBT                is_on_boundary;
29034d379d7bSStefano Zampini 
29044d379d7bSStefano Zampini       ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n,0,1,&is_dummy);CHKERRQ(ierr);
29054d379d7bSStefano Zampini       ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
29064d379d7bSStefano Zampini       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
29074d379d7bSStefano Zampini       ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
29084d379d7bSStefano Zampini       ierr = PCBDDCGraphInit(graph,l2gmap_dummy);CHKERRQ(ierr);
29094d379d7bSStefano Zampini       ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2910e496cd5dSStefano Zampini       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2911e496cd5dSStefano Zampini       if (flg_row) {
29124d379d7bSStefano Zampini         graph->xadj = xadj;
29134d379d7bSStefano Zampini         graph->adjncy = adjncy;
2914e496cd5dSStefano Zampini       }
29154d379d7bSStefano Zampini       ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
29164d379d7bSStefano Zampini       ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2917e496cd5dSStefano Zampini       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
29184d379d7bSStefano Zampini 
29194d379d7bSStefano Zampini       if (pcbddc->dbg_flag) {
29204d379d7bSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"[%d] Found %d subdomains\n",PetscGlobalRank,graph->ncc);CHKERRQ(ierr);
29214d379d7bSStefano Zampini         for (i=0;i<graph->ncc;i++) {
29224d379d7bSStefano Zampini           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"[%d] %d cc size %d\n",PetscGlobalRank,i,graph->cptr[i+1]-graph->cptr[i]);CHKERRQ(ierr);
29234d379d7bSStefano Zampini         }
29244d379d7bSStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
29254d379d7bSStefano Zampini       }
29264d379d7bSStefano Zampini 
2927e496cd5dSStefano Zampini       ierr = PetscBTCreate(pcis->n,&is_on_boundary);CHKERRQ(ierr);
29284d379d7bSStefano Zampini       ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
29294d379d7bSStefano Zampini       for (i=0;i<pcis->n_B;i++) {
29304d379d7bSStefano Zampini         ierr = PetscBTSet(is_on_boundary,idxs[i]);CHKERRQ(ierr);
29314d379d7bSStefano Zampini       }
29324d379d7bSStefano Zampini       ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
29334d379d7bSStefano Zampini 
2934e496cd5dSStefano Zampini       ierr = PetscCalloc1(pcis->n+1,&cxadj);CHKERRQ(ierr);
29354d379d7bSStefano Zampini       sum = 0;
29364d379d7bSStefano Zampini       for (i=0;i<graph->ncc;i++) {
29374d379d7bSStefano Zampini         PetscInt sizecc = 0;
29384d379d7bSStefano Zampini         for (j=graph->cptr[i];j<graph->cptr[i+1];j++) {
29394d379d7bSStefano Zampini           if (PetscBTLookup(is_on_boundary,graph->queue[j])) {
29404d379d7bSStefano Zampini             sizecc++;
29414d379d7bSStefano Zampini           }
29424d379d7bSStefano Zampini         }
29434d379d7bSStefano Zampini         for (j=graph->cptr[i];j<graph->cptr[i+1];j++) {
29444d379d7bSStefano Zampini           if (PetscBTLookup(is_on_boundary,graph->queue[j])) {
29454d379d7bSStefano Zampini             cxadj[graph->queue[j]] = sizecc;
29464d379d7bSStefano Zampini           }
29474d379d7bSStefano Zampini         }
29484d379d7bSStefano Zampini         sum += sizecc*sizecc;
29494d379d7bSStefano Zampini       }
29504d379d7bSStefano Zampini       ierr = PetscMalloc1(sum,&cadjncy);CHKERRQ(ierr);
29514d379d7bSStefano Zampini       sum = 0;
2952e496cd5dSStefano Zampini       for (i=0;i<pcis->n;i++) {
29534d379d7bSStefano Zampini         PetscInt temp = cxadj[i];
29544d379d7bSStefano Zampini         cxadj[i] = sum;
29554d379d7bSStefano Zampini         sum += temp;
29564d379d7bSStefano Zampini       }
2957e496cd5dSStefano Zampini       cxadj[pcis->n] = sum;
29584d379d7bSStefano Zampini       for (i=0;i<graph->ncc;i++) {
29594d379d7bSStefano Zampini         for (j=graph->cptr[i];j<graph->cptr[i+1];j++) {
29604d379d7bSStefano Zampini           if (PetscBTLookup(is_on_boundary,graph->queue[j])) {
29614d379d7bSStefano Zampini             PetscInt k,sizecc = 0;
29624d379d7bSStefano Zampini             for (k=graph->cptr[i];k<graph->cptr[i+1];k++) {
29634d379d7bSStefano Zampini               if (PetscBTLookup(is_on_boundary,graph->queue[k])) {
29644d379d7bSStefano Zampini                 cadjncy[cxadj[graph->queue[j]]+sizecc]=graph->queue[k];
29654d379d7bSStefano Zampini                 sizecc++;
29664d379d7bSStefano Zampini               }
29674d379d7bSStefano Zampini             }
29684d379d7bSStefano Zampini           }
29694d379d7bSStefano Zampini         }
29704d379d7bSStefano Zampini       }
2971e496cd5dSStefano Zampini       if (pcis->n) {
2972e496cd5dSStefano Zampini         ierr = PCBDDCSetLocalAdjacencyGraph(pc,pcis->n,cxadj,cadjncy,PETSC_OWN_POINTER);CHKERRQ(ierr);
29734d379d7bSStefano Zampini       } else {
29744d379d7bSStefano Zampini         ierr = PetscFree(cxadj);CHKERRQ(ierr);
29754d379d7bSStefano Zampini         ierr = PetscFree(cadjncy);CHKERRQ(ierr);
29764d379d7bSStefano Zampini       }
29774d379d7bSStefano Zampini       graph->xadj = 0;
29784d379d7bSStefano Zampini       graph->adjncy = 0;
29794d379d7bSStefano Zampini       ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
29804d379d7bSStefano Zampini       ierr = PetscBTDestroy(&is_on_boundary);CHKERRQ(ierr);
29814d379d7bSStefano Zampini     }
2982674ae819SStefano Zampini   }
2983674ae819SStefano Zampini 
298463602bcaSStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting or PCBDDCSetDofsSplittingLocal */
2985674ae819SStefano Zampini   vertex_size = 1;
298663602bcaSStefano Zampini   if (pcbddc->user_provided_isfordofs) {
298763602bcaSStefano Zampini     if (pcbddc->n_ISForDofs) { /* need to convert from global to local and remove references to global dofs splitting */
298895ecbf38SStefano Zampini       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
298963602bcaSStefano Zampini       for (i=0;i<pcbddc->n_ISForDofs;i++) {
2990a7dc3881SStefano Zampini         ierr = PCBDDCGlobalToLocal(matis->ctx,pcis->vec1_global,pcis->vec1_N,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
299163602bcaSStefano Zampini         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
2992674ae819SStefano Zampini       }
299363602bcaSStefano Zampini       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
299463602bcaSStefano Zampini       pcbddc->n_ISForDofs = 0;
299563602bcaSStefano Zampini       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
2996674ae819SStefano Zampini     }
299763602bcaSStefano Zampini     /* mat block size as vertex size (used for elasticity with rigid body modes as nearnullspace) */
2998674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
299963602bcaSStefano Zampini   } else {
300063602bcaSStefano Zampini     if (!pcbddc->n_ISForDofsLocal) { /* field split not present, create it in local ordering */
300163602bcaSStefano Zampini       ierr = MatGetBlockSize(pc->pmat,&pcbddc->n_ISForDofsLocal);CHKERRQ(ierr);
3002854ce69bSBarry Smith       ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
300363602bcaSStefano Zampini       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
300463602bcaSStefano Zampini         ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),pcis->n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
300563602bcaSStefano Zampini       }
300663602bcaSStefano Zampini     }
3007674ae819SStefano Zampini   }
3008674ae819SStefano Zampini 
3009674ae819SStefano Zampini   /* Setup of Graph */
3010785d1243SStefano Zampini   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) { /* need to convert from global to local */
3011a7dc3881SStefano Zampini     ierr = PCBDDCGlobalToLocal(matis->ctx,pcis->vec1_global,pcis->vec1_N,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3012785d1243SStefano Zampini   }
3013785d1243SStefano Zampini   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) { /* need to convert from global to local */
3014a7dc3881SStefano Zampini     ierr = PCBDDCGlobalToLocal(matis->ctx,pcis->vec1_global,pcis->vec1_N,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3015785d1243SStefano Zampini   }
301663602bcaSStefano Zampini   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices);
3017674ae819SStefano Zampini 
3018674ae819SStefano Zampini   /* Graph's connected components analysis */
3019674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
3020674ae819SStefano Zampini 
3021674ae819SStefano Zampini   /* print some info to stdout */
3022674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
3023e49050b4SStefano Zampini     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);
3024674ae819SStefano Zampini   }
3025fb180af4SStefano Zampini 
3026fb180af4SStefano Zampini   /* mark topography has done */
3027fb180af4SStefano Zampini   pcbddc->recompute_topography = PETSC_FALSE;
3028674ae819SStefano Zampini   PetscFunctionReturn(0);
3029674ae819SStefano Zampini }
3030674ae819SStefano Zampini 
3031674ae819SStefano Zampini #undef __FUNCT__
3032674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
3033f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt **vertices_idx)
3034674ae819SStefano Zampini {
3035674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
3036674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
3037674ae819SStefano Zampini   PetscErrorCode ierr;
3038674ae819SStefano Zampini 
3039674ae819SStefano Zampini   PetscFunctionBegin;
3040674ae819SStefano Zampini   n = 0;
3041674ae819SStefano Zampini   vertices = 0;
3042674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
3043674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
3044b120a5c6SStefano Zampini     for (i=0;i<local_primal_size;i++) {
3045b120a5c6SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
3046b120a5c6SStefano Zampini       if (size_of_constraint == 1) n++;
3047b120a5c6SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
3048b120a5c6SStefano Zampini     }
3049811e8ca2SStefano Zampini     if (vertices_idx) {
3050785e854fSJed Brown       ierr = PetscMalloc1(n,&vertices);CHKERRQ(ierr);
3051b120a5c6SStefano Zampini       n = 0;
3052674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
3053674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
3054674ae819SStefano Zampini         if (size_of_constraint == 1) {
3055674ae819SStefano Zampini           vertices[n++]=row_cmat_indices[0];
3056674ae819SStefano Zampini         }
3057674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
3058674ae819SStefano Zampini       }
3059674ae819SStefano Zampini     }
3060811e8ca2SStefano Zampini   }
3061674ae819SStefano Zampini   *n_vertices = n;
3062811e8ca2SStefano Zampini   if (vertices_idx) *vertices_idx = vertices;
3063674ae819SStefano Zampini   PetscFunctionReturn(0);
3064674ae819SStefano Zampini }
3065674ae819SStefano Zampini 
3066674ae819SStefano Zampini #undef __FUNCT__
3067674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
3068f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt **constraints_idx)
3069674ae819SStefano Zampini {
3070674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
3071674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
3072674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
30734641a718SStefano Zampini   PetscBT        touched;
3074674ae819SStefano Zampini   PetscErrorCode ierr;
3075674ae819SStefano Zampini 
3076f34684f1SStefano Zampini     /* This function assumes that the number of local constraints per connected component
3077f34684f1SStefano Zampini        is not greater than the number of nodes defined for the connected component
3078f34684f1SStefano Zampini        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
3079674ae819SStefano Zampini   PetscFunctionBegin;
3080674ae819SStefano Zampini   n = 0;
3081674ae819SStefano Zampini   constraints_index = 0;
3082674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
3083674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
3084674ae819SStefano Zampini     max_size_of_constraint = 0;
3085674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
3086674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
3087674ae819SStefano Zampini       if (size_of_constraint > 1) {
3088674ae819SStefano Zampini         n++;
3089674ae819SStefano Zampini       }
3090674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
3091674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
3092674ae819SStefano Zampini     }
3093811e8ca2SStefano Zampini     if (constraints_idx) {
3094785e854fSJed Brown       ierr = PetscMalloc1(n,&constraints_index);CHKERRQ(ierr);
3095785e854fSJed Brown       ierr = PetscMalloc1(max_size_of_constraint,&row_cmat_global_indices);CHKERRQ(ierr);
30964641a718SStefano Zampini       ierr = PetscBTCreate(local_size,&touched);CHKERRQ(ierr);
3097674ae819SStefano Zampini       n = 0;
3098674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
3099674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
3100674ae819SStefano Zampini         if (size_of_constraint > 1) {
3101674ae819SStefano Zampini           ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
310282d3d8afSStefano Zampini           /* find first untouched local node */
310382d3d8afSStefano Zampini           j = 0;
31044641a718SStefano Zampini           while (PetscBTLookup(touched,row_cmat_indices[j])) j++;
310582d3d8afSStefano Zampini           min_index = row_cmat_global_indices[j];
310682d3d8afSStefano Zampini           min_loc = j;
310782d3d8afSStefano Zampini           /* search the minimum among nodes not yet touched on the connected component
310882d3d8afSStefano Zampini              since there can be more than one constraint on a single cc */
3109674ae819SStefano Zampini           for (j=1;j<size_of_constraint;j++) {
31104641a718SStefano Zampini             if (!PetscBTLookup(touched,row_cmat_indices[j]) && min_index > row_cmat_global_indices[j]) {
3111674ae819SStefano Zampini               min_index = row_cmat_global_indices[j];
3112674ae819SStefano Zampini               min_loc = j;
3113674ae819SStefano Zampini             }
3114674ae819SStefano Zampini           }
31154641a718SStefano Zampini           ierr = PetscBTSet(touched,row_cmat_indices[min_loc]);CHKERRQ(ierr);
3116674ae819SStefano Zampini           constraints_index[n++] = row_cmat_indices[min_loc];
3117674ae819SStefano Zampini         }
3118674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
3119674ae819SStefano Zampini       }
31204641a718SStefano Zampini       ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
3121674ae819SStefano Zampini       ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
3122811e8ca2SStefano Zampini     }
3123811e8ca2SStefano Zampini   }
3124674ae819SStefano Zampini   *n_constraints = n;
3125811e8ca2SStefano Zampini   if (constraints_idx) *constraints_idx = constraints_index;
3126674ae819SStefano Zampini   PetscFunctionReturn(0);
3127674ae819SStefano Zampini }
3128674ae819SStefano Zampini 
3129674ae819SStefano Zampini #undef __FUNCT__
3130674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
3131674ae819SStefano 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[])
3132674ae819SStefano Zampini {
3133674ae819SStefano Zampini   Vec            local_vec,global_vec;
3134674ae819SStefano Zampini   IS             seqis,paris;
3135674ae819SStefano Zampini   VecScatter     scatter_ctx;
3136674ae819SStefano Zampini   PetscScalar    *array;
3137674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
3138674ae819SStefano Zampini   PetscScalar    globalsum;
3139674ae819SStefano Zampini   PetscInt       i,j,s;
314017ccb9bdSStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local,max_global;
314117ccb9bdSStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm;
314217ccb9bdSStefano Zampini   PetscInt       *dof_sizes,*dof_displs;
3143674ae819SStefano Zampini   PetscBool      first_found;
3144674ae819SStefano Zampini   PetscErrorCode ierr;
3145674ae819SStefano Zampini 
3146674ae819SStefano Zampini   PetscFunctionBegin;
3147674ae819SStefano Zampini   /* mpi buffers */
3148b9b85e73SStefano Zampini   ierr = MPI_Comm_size(comm,&size_prec_comm);CHKERRQ(ierr);
3149b9b85e73SStefano Zampini   ierr = MPI_Comm_rank(comm,&rank_prec_comm);CHKERRQ(ierr);
3150674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
315117ccb9bdSStefano Zampini   ierr = PetscMalloc2(j,&dof_sizes,j,&dof_displs);CHKERRQ(ierr);
3152674ae819SStefano Zampini   /* get maximum size of subset */
3153785e854fSJed Brown   ierr = PetscMalloc1(n_local_dofs,&temp_global_dofs);CHKERRQ(ierr);
3154674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
3155674ae819SStefano Zampini   max_local = 0;
3156b9b85e73SStefano Zampini   for (i=0;i<n_local_dofs;i++) {
3157674ae819SStefano Zampini     if (max_local < temp_global_dofs[i] ) {
3158674ae819SStefano Zampini       max_local = temp_global_dofs[i];
3159674ae819SStefano Zampini     }
3160674ae819SStefano Zampini   }
3161b9b85e73SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);CHKERRQ(ierr);
3162674ae819SStefano Zampini   max_global++;
3163674ae819SStefano Zampini   max_local = 0;
3164b9b85e73SStefano Zampini   for (i=0;i<n_local_dofs;i++) {
3165674ae819SStefano Zampini     if (max_local < local_dofs[i] ) {
3166674ae819SStefano Zampini       max_local = local_dofs[i];
3167674ae819SStefano Zampini     }
3168674ae819SStefano Zampini   }
3169674ae819SStefano Zampini   max_local++;
3170674ae819SStefano Zampini   /* allocate workspace */
3171674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
3172674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
3173674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
3174674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
3175674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
3176674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
3177674ae819SStefano Zampini   /* create scatter */
3178674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
3179674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
3180674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
3181674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
3182674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
3183674ae819SStefano Zampini   /* init array */
3184674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
3185674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
3186674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
3187674ae819SStefano Zampini   if (local_dofs_mult) {
3188674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
3189674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
3190674ae819SStefano Zampini     }
3191674ae819SStefano Zampini   } else {
3192674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
3193674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
3194674ae819SStefano Zampini     }
3195674ae819SStefano Zampini   }
3196674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
3197674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
3198674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3199674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3200674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
32015b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
3202674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
3203674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
3204674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
3205674ae819SStefano Zampini   nlocals = 0;
3206674ae819SStefano Zampini   first_index = -1;
3207674ae819SStefano Zampini   first_found = PETSC_FALSE;
3208674ae819SStefano Zampini   for (i=0;i<s;i++) {
3209b9b85e73SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.1) {
3210674ae819SStefano Zampini       first_found = PETSC_TRUE;
3211674ae819SStefano Zampini       first_index = i;
3212674ae819SStefano Zampini     }
32135b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
3214674ae819SStefano Zampini   }
3215674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
3216674ae819SStefano Zampini   if (!rank_prec_comm) {
3217674ae819SStefano Zampini     dof_displs[0]=0;
3218674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
3219674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
3220674ae819SStefano Zampini     }
3221674ae819SStefano Zampini   }
3222674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
3223674ae819SStefano Zampini   if (first_found) {
3224674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
3225674ae819SStefano Zampini     old_index = first_index;
3226674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
3227b9b85e73SStefano Zampini       if (PetscRealPart(array[i]) > 0.1) {
3228674ae819SStefano Zampini         array[i] += array[old_index];
3229674ae819SStefano Zampini         old_index = i;
3230674ae819SStefano Zampini       }
3231674ae819SStefano Zampini     }
3232674ae819SStefano Zampini   }
3233674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
3234674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
3235674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3236674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3237674ae819SStefano Zampini   /* get global ordering of local dofs */
32382b095fd8SStefano Zampini   ierr = VecGetArrayRead(local_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
3239674ae819SStefano Zampini   if (local_dofs_mult) {
3240674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
32415b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
3242674ae819SStefano Zampini     }
3243674ae819SStefano Zampini   } else {
3244674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
32455b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
3246674ae819SStefano Zampini     }
3247674ae819SStefano Zampini   }
32482b095fd8SStefano Zampini   ierr = VecRestoreArrayRead(local_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
3249674ae819SStefano Zampini   /* free workspace */
3250674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
3251674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
3252674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
325317ccb9bdSStefano Zampini   ierr = PetscFree2(dof_sizes,dof_displs);CHKERRQ(ierr);
3254674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
3255674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
3256674ae819SStefano Zampini   PetscFunctionReturn(0);
3257674ae819SStefano Zampini }
32589a7d3425SStefano Zampini 
32599a7d3425SStefano Zampini #undef __FUNCT__
32609a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
32619a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
32629a7d3425SStefano Zampini {
32639a7d3425SStefano Zampini   PetscInt       i,j;
32649a7d3425SStefano Zampini   PetscScalar    *alphas;
32659a7d3425SStefano Zampini   PetscErrorCode ierr;
32669a7d3425SStefano Zampini 
32679a7d3425SStefano Zampini   PetscFunctionBegin;
32689a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
3269785e854fSJed Brown   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
32709a7d3425SStefano Zampini   for (i=0;i<n;i++) {
32719a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
32729a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
32739a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
32749a7d3425SStefano Zampini   }
32759a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
32769a7d3425SStefano Zampini   PetscFunctionReturn(0);
32779a7d3425SStefano Zampini }
32789a7d3425SStefano Zampini 
3279e7931f94SStefano Zampini #undef __FUNCT__
328070cf5478SStefano Zampini #define __FUNCT__ "MatISGetSubassemblingPattern"
328128143c3dSStefano Zampini PetscErrorCode MatISGetSubassemblingPattern(Mat mat, PetscInt n_subdomains, PetscBool contiguous, IS* is_sends)
3282e7931f94SStefano Zampini {
3283e7931f94SStefano Zampini   Mat             subdomain_adj;
3284e7931f94SStefano Zampini   IS              new_ranks,ranks_send_to;
3285e7931f94SStefano Zampini   MatPartitioning partitioner;
3286e7931f94SStefano Zampini   Mat_IS          *matis;
3287e7931f94SStefano Zampini   PetscInt        n_neighs,*neighs,*n_shared,**shared;
3288e7931f94SStefano Zampini   PetscInt        prank;
3289e7931f94SStefano Zampini   PetscMPIInt     size,rank,color;
3290e7931f94SStefano Zampini   PetscInt        *xadj,*adjncy,*oldranks;
3291e7931f94SStefano Zampini   PetscInt        *adjncy_wgt,*v_wgt,*is_indices,*ranks_send_to_idx;
32923837a79fSStefano Zampini   PetscInt        i,local_size,threshold=0;
3293e7931f94SStefano Zampini   PetscErrorCode  ierr;
32942b510759SStefano Zampini   PetscBool       use_vwgt=PETSC_FALSE,use_square=PETSC_FALSE;
3295e7931f94SStefano Zampini   PetscSubcomm    subcomm;
3296a57a6d2fSStefano Zampini 
3297e7931f94SStefano Zampini   PetscFunctionBegin;
32982b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_square",&use_square,NULL);CHKERRQ(ierr);
32992b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
33002b510759SStefano Zampini   ierr = PetscOptionsGetInt(NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
3301e7931f94SStefano Zampini 
3302e7931f94SStefano Zampini   /* Get info on mapping */
3303e7931f94SStefano Zampini   matis = (Mat_IS*)(mat->data);
3304e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&local_size);CHKERRQ(ierr);
3305e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
3306e7931f94SStefano Zampini 
3307e7931f94SStefano Zampini   /* build local CSR graph of subdomains' connectivity */
3308785e854fSJed Brown   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
3309e7931f94SStefano Zampini   xadj[0] = 0;
3310e7931f94SStefano Zampini   xadj[1] = PetscMax(n_neighs-1,0);
3311785e854fSJed Brown   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
3312785e854fSJed Brown   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
3313e7931f94SStefano Zampini 
33142b510759SStefano Zampini   if (threshold) {
3315d023bfaeSStefano Zampini     PetscInt xadj_count = 0;
33162b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
3317d023bfaeSStefano Zampini       if (n_shared[i] > threshold) {
3318d023bfaeSStefano Zampini         adjncy[xadj_count] = neighs[i];
3319d023bfaeSStefano Zampini         adjncy_wgt[xadj_count] = n_shared[i];
3320d023bfaeSStefano Zampini         xadj_count++;
3321e7931f94SStefano Zampini       }
3322e7931f94SStefano Zampini     }
3323d023bfaeSStefano Zampini     xadj[1] = xadj_count;
3324c8587f34SStefano Zampini   } else {
3325e7931f94SStefano Zampini     if (xadj[1]) {
3326e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy,&neighs[1],xadj[1]*sizeof(*adjncy));CHKERRQ(ierr);
3327e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy_wgt,&n_shared[1],xadj[1]*sizeof(*adjncy_wgt));CHKERRQ(ierr);
3328c8587f34SStefano Zampini     }
3329e7931f94SStefano Zampini   }
3330e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingRestoreInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
3331e7931f94SStefano Zampini   if (use_square) {
3332e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
3333e7931f94SStefano Zampini       adjncy_wgt[i] = adjncy_wgt[i]*adjncy_wgt[i];
3334e7931f94SStefano Zampini     }
3335e7931f94SStefano Zampini   }
3336e7931f94SStefano Zampini   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
3337e7931f94SStefano Zampini 
33383837a79fSStefano Zampini   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
3339e7931f94SStefano Zampini 
3340e7931f94SStefano Zampini   /*
3341e7931f94SStefano Zampini     Restrict work on active processes only.
3342e7931f94SStefano Zampini   */
3343e7931f94SStefano Zampini   ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&subcomm);CHKERRQ(ierr);
3344e7931f94SStefano Zampini   ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
3345e7931f94SStefano Zampini   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
33462b510759SStefano Zampini   ierr = PetscMPIIntCast(!local_size,&color);CHKERRQ(ierr);
3347d3531aaaSJed Brown   ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
3348e7931f94SStefano Zampini   if (color) {
3349e7931f94SStefano Zampini     ierr = PetscFree(xadj);CHKERRQ(ierr);
3350e7931f94SStefano Zampini     ierr = PetscFree(adjncy);CHKERRQ(ierr);
3351e7931f94SStefano Zampini     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
3352c8587f34SStefano Zampini   } else {
335328143c3dSStefano Zampini     PetscInt coarsening_ratio;
3354306c2d5bSBarry Smith     ierr = MPI_Comm_size(PetscSubcommChild(subcomm),&size);CHKERRQ(ierr);
3355785e854fSJed Brown     ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
3356e7931f94SStefano Zampini     prank = rank;
3357306c2d5bSBarry Smith     ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,PetscSubcommChild(subcomm));CHKERRQ(ierr);
33588002ef2cSStefano Zampini     /*
3359e7931f94SStefano Zampini     for (i=0;i<size;i++) {
3360e7931f94SStefano Zampini       PetscPrintf(subcomm->comm,"oldranks[%d] = %d\n",i,oldranks[i]);
3361c8587f34SStefano Zampini     }
33628002ef2cSStefano Zampini     */
3363e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
3364e7931f94SStefano Zampini       ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
3365c8587f34SStefano Zampini     }
3366e7931f94SStefano Zampini     ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
3367306c2d5bSBarry Smith     ierr = MatCreateMPIAdj(PetscSubcommChild(subcomm),1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
336822b6e8a2SStefano Zampini     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
3369e7931f94SStefano Zampini 
3370e7931f94SStefano Zampini     /* Partition */
3371306c2d5bSBarry Smith     ierr = MatPartitioningCreate(PetscSubcommChild(subcomm),&partitioner);CHKERRQ(ierr);
3372e7931f94SStefano Zampini     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
3373e7931f94SStefano Zampini     if (use_vwgt) {
33743837a79fSStefano Zampini       ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
3375e7931f94SStefano Zampini       v_wgt[0] = local_size;
3376e7931f94SStefano Zampini       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
3377c8587f34SStefano Zampini     }
337828143c3dSStefano Zampini     n_subdomains = PetscMin((PetscInt)size,n_subdomains);
337928143c3dSStefano Zampini     coarsening_ratio = size/n_subdomains;
338028143c3dSStefano Zampini     ierr = MatPartitioningSetNParts(partitioner,n_subdomains);CHKERRQ(ierr);
3381e7931f94SStefano Zampini     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
3382e7931f94SStefano Zampini     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
338322b6e8a2SStefano Zampini     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
3384e7931f94SStefano Zampini 
3385e7931f94SStefano Zampini     ierr = ISGetIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
338628143c3dSStefano Zampini     if (contiguous) {
338728143c3dSStefano Zampini       ranks_send_to_idx[0] = oldranks[is_indices[0]]; /* contiguos set of processes */
338828143c3dSStefano Zampini     } else {
338984ba6060SStefano Zampini       ranks_send_to_idx[0] = coarsening_ratio*oldranks[is_indices[0]]; /* scattered set of processes */
339028143c3dSStefano Zampini     }
3391e7931f94SStefano Zampini     ierr = ISRestoreIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
3392e7931f94SStefano Zampini     /* clean up */
3393e7931f94SStefano Zampini     ierr = PetscFree(oldranks);CHKERRQ(ierr);
3394e7931f94SStefano Zampini     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
3395e7931f94SStefano Zampini     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
3396e7931f94SStefano Zampini     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
3397e7931f94SStefano Zampini   }
3398e7931f94SStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
3399e7931f94SStefano Zampini 
3400e7931f94SStefano Zampini   /* assemble parallel IS for sends */
3401e7931f94SStefano Zampini   i = 1;
3402e7931f94SStefano Zampini   if (color) i=0;
3403e7931f94SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,&ranks_send_to);CHKERRQ(ierr);
3404e7931f94SStefano Zampini 
3405e7931f94SStefano Zampini   /* get back IS */
3406e7931f94SStefano Zampini   *is_sends = ranks_send_to;
3407e7931f94SStefano Zampini   PetscFunctionReturn(0);
3408e7931f94SStefano Zampini }
3409e7931f94SStefano Zampini 
3410e7931f94SStefano Zampini typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
3411e7931f94SStefano Zampini 
3412e7931f94SStefano Zampini #undef __FUNCT__
3413e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble"
341428143c3dSStefano Zampini PetscErrorCode MatISSubassemble(Mat mat, IS is_sends, PetscInt n_subdomains, PetscBool restrict_comm, MatReuse reuse, Mat *mat_n, PetscInt nis, IS isarray[])
3415e7931f94SStefano Zampini {
341670cf5478SStefano Zampini   Mat                    local_mat;
3417e7931f94SStefano Zampini   Mat_IS                 *matis;
3418e7931f94SStefano Zampini   IS                     is_sends_internal;
34199d30be91SStefano Zampini   PetscInt               rows,cols,new_local_rows;
342028143c3dSStefano Zampini   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals;
34219d30be91SStefano Zampini   PetscBool              ismatis,isdense,newisdense,destroy_mat;
3422e7931f94SStefano Zampini   ISLocalToGlobalMapping l2gmap;
3423e7931f94SStefano Zampini   PetscInt*              l2gmap_indices;
3424e7931f94SStefano Zampini   const PetscInt*        is_indices;
3425e7931f94SStefano Zampini   MatType                new_local_type;
3426e7931f94SStefano Zampini   /* buffers */
3427e7931f94SStefano Zampini   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
342828143c3dSStefano Zampini   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
34299d30be91SStefano Zampini   PetscInt               *recv_buffer_idxs_local;
3430e7931f94SStefano Zampini   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
3431e7931f94SStefano Zampini   /* MPI */
343228143c3dSStefano Zampini   MPI_Comm               comm,comm_n;
343328143c3dSStefano Zampini   PetscSubcomm           subcomm;
3434e7931f94SStefano Zampini   PetscMPIInt            n_sends,n_recvs,commsize;
343528143c3dSStefano Zampini   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
343628143c3dSStefano Zampini   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
343728143c3dSStefano Zampini   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,source_dest;
343828143c3dSStefano Zampini   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals;
343928143c3dSStefano Zampini   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals;
3440e7931f94SStefano Zampini   PetscErrorCode         ierr;
3441e7931f94SStefano Zampini 
3442e7931f94SStefano Zampini   PetscFunctionBegin;
344328143c3dSStefano Zampini   /* TODO: add missing checks */
344428143c3dSStefano Zampini   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
344528143c3dSStefano Zampini   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
344628143c3dSStefano Zampini   PetscValidLogicalCollectiveEnum(mat,reuse,5);
344728143c3dSStefano Zampini   PetscValidLogicalCollectiveInt(mat,nis,7);
3448e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
344928143c3dSStefano Zampini   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",__FUNCT__);
3450e7931f94SStefano Zampini   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
3451e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
3452e7931f94SStefano Zampini   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
3453e7931f94SStefano Zampini   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
3454e7931f94SStefano Zampini   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
345528143c3dSStefano Zampini   if (reuse == MAT_REUSE_MATRIX && *mat_n) {
345670cf5478SStefano Zampini     PetscInt mrows,mcols,mnrows,mncols;
345770cf5478SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
345828143c3dSStefano Zampini     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
345970cf5478SStefano Zampini     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
346070cf5478SStefano Zampini     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
346170cf5478SStefano Zampini     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
346270cf5478SStefano Zampini     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
346370cf5478SStefano Zampini   }
3464e7931f94SStefano Zampini   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
3465e7931f94SStefano Zampini   PetscValidLogicalCollectiveInt(mat,bs,0);
3466e7931f94SStefano Zampini   /* prepare IS for sending if not provided */
3467e7931f94SStefano Zampini   if (!is_sends) {
346828143c3dSStefano Zampini     PetscBool pcontig = PETSC_TRUE;
346928143c3dSStefano Zampini     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
347028143c3dSStefano Zampini     ierr = MatISGetSubassemblingPattern(mat,n_subdomains,pcontig,&is_sends_internal);CHKERRQ(ierr);
3471c8587f34SStefano Zampini   } else {
3472e7931f94SStefano Zampini     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
3473e7931f94SStefano Zampini     is_sends_internal = is_sends;
3474c8587f34SStefano Zampini   }
3475e7931f94SStefano Zampini 
3476e7931f94SStefano Zampini   /* get pointer of MATIS data */
3477e7931f94SStefano Zampini   matis = (Mat_IS*)mat->data;
3478e7931f94SStefano Zampini 
3479e7931f94SStefano Zampini   /* get comm */
3480a316fed8SStefano Zampini   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
3481e7931f94SStefano Zampini 
3482e7931f94SStefano Zampini   /* compute number of sends */
3483e7931f94SStefano Zampini   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
3484e7931f94SStefano Zampini   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
3485e7931f94SStefano Zampini 
3486e7931f94SStefano Zampini   /* compute number of receives */
3487e7931f94SStefano Zampini   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
3488785e854fSJed Brown   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
3489e7931f94SStefano Zampini   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
3490e7931f94SStefano Zampini   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
3491e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
3492e7931f94SStefano Zampini   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
3493e7931f94SStefano Zampini   ierr = PetscFree(iflags);CHKERRQ(ierr);
3494e7931f94SStefano Zampini 
349528143c3dSStefano Zampini   /* restrict comm if requested */
349628143c3dSStefano Zampini   subcomm = 0;
349728143c3dSStefano Zampini   destroy_mat = PETSC_FALSE;
349828143c3dSStefano Zampini   if (restrict_comm) {
3499779c1cceSStefano Zampini     PetscMPIInt color,subcommsize;
3500779c1cceSStefano Zampini 
350128143c3dSStefano Zampini     color = 0;
3502779c1cceSStefano Zampini     if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm */
350328143c3dSStefano Zampini     ierr = MPI_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
350428143c3dSStefano Zampini     subcommsize = commsize - subcommsize;
350528143c3dSStefano Zampini     /* check if reuse has been requested */
350628143c3dSStefano Zampini     if (reuse == MAT_REUSE_MATRIX) {
350728143c3dSStefano Zampini       if (*mat_n) {
350828143c3dSStefano Zampini         PetscMPIInt subcommsize2;
350928143c3dSStefano Zampini         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
351028143c3dSStefano Zampini         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
351128143c3dSStefano Zampini         comm_n = PetscObjectComm((PetscObject)*mat_n);
351228143c3dSStefano Zampini       } else {
351328143c3dSStefano Zampini         comm_n = PETSC_COMM_SELF;
351428143c3dSStefano Zampini       }
351528143c3dSStefano Zampini     } else { /* MAT_INITIAL_MATRIX */
3516779c1cceSStefano Zampini       PetscMPIInt rank;
3517779c1cceSStefano Zampini 
3518779c1cceSStefano Zampini       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
351928143c3dSStefano Zampini       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
352028143c3dSStefano Zampini       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
352128143c3dSStefano Zampini       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
3522306c2d5bSBarry Smith       comm_n = PetscSubcommChild(subcomm);
352328143c3dSStefano Zampini     }
352428143c3dSStefano Zampini     /* flag to destroy *mat_n if not significative */
352528143c3dSStefano Zampini     if (color) destroy_mat = PETSC_TRUE;
352628143c3dSStefano Zampini   } else {
352728143c3dSStefano Zampini     comm_n = comm;
352828143c3dSStefano Zampini   }
352928143c3dSStefano Zampini 
3530e7931f94SStefano Zampini   /* prepare send/receive buffers */
3531785e854fSJed Brown   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
3532e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
3533785e854fSJed Brown   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
3534e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
353528143c3dSStefano Zampini   if (nis) {
3536854ce69bSBarry Smith     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
353728143c3dSStefano Zampini   }
3538e7931f94SStefano Zampini 
353928143c3dSStefano Zampini   /* Get data from local matrices */
3540e7931f94SStefano Zampini   if (!isdense) {
3541a26c9d0eSStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
3542e7931f94SStefano Zampini     /* TODO: See below some guidelines on how to prepare the local buffers */
3543e7931f94SStefano Zampini     /*
3544e7931f94SStefano Zampini        send_buffer_vals should contain the raw values of the local matrix
3545e7931f94SStefano Zampini        send_buffer_idxs should contain:
3546e7931f94SStefano Zampini        - MatType_PRIVATE type
3547e7931f94SStefano Zampini        - PetscInt        size_of_l2gmap
3548e7931f94SStefano Zampini        - PetscInt        global_row_indices[size_of_l2gmap]
3549e7931f94SStefano Zampini        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
3550e7931f94SStefano Zampini     */
3551e7931f94SStefano Zampini   } else {
3552e7931f94SStefano Zampini     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
3553e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&i);CHKERRQ(ierr);
3554854ce69bSBarry Smith     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
3555e7931f94SStefano Zampini     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
3556e7931f94SStefano Zampini     send_buffer_idxs[1] = i;
3557e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
3558e7931f94SStefano Zampini     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
3559e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingRestoreIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
3560e7931f94SStefano Zampini     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
3561e7931f94SStefano Zampini     for (i=0;i<n_sends;i++) {
3562e7931f94SStefano Zampini       ilengths_vals[is_indices[i]] = len*len;
3563e7931f94SStefano Zampini       ilengths_idxs[is_indices[i]] = len+2;
3564c8587f34SStefano Zampini     }
3565c8587f34SStefano Zampini   }
3566e7931f94SStefano Zampini   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
356728143c3dSStefano Zampini   /* additional is (if any) */
356828143c3dSStefano Zampini   if (nis) {
356928143c3dSStefano Zampini     PetscMPIInt psum;
357028143c3dSStefano Zampini     PetscInt j;
357128143c3dSStefano Zampini     for (j=0,psum=0;j<nis;j++) {
357228143c3dSStefano Zampini       PetscInt plen;
357328143c3dSStefano Zampini       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
357428143c3dSStefano Zampini       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
357528143c3dSStefano Zampini       psum += len+1; /* indices + lenght */
357628143c3dSStefano Zampini     }
3577854ce69bSBarry Smith     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
357828143c3dSStefano Zampini     for (j=0,psum=0;j<nis;j++) {
357928143c3dSStefano Zampini       PetscInt plen;
358028143c3dSStefano Zampini       const PetscInt *is_array_idxs;
358128143c3dSStefano Zampini       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
358228143c3dSStefano Zampini       send_buffer_idxs_is[psum] = plen;
358328143c3dSStefano Zampini       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
358428143c3dSStefano Zampini       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
358528143c3dSStefano Zampini       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
358628143c3dSStefano Zampini       psum += plen+1; /* indices + lenght */
358728143c3dSStefano Zampini     }
358828143c3dSStefano Zampini     for (i=0;i<n_sends;i++) {
358928143c3dSStefano Zampini       ilengths_idxs_is[is_indices[i]] = psum;
359028143c3dSStefano Zampini     }
359128143c3dSStefano Zampini     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
359228143c3dSStefano Zampini   }
359328143c3dSStefano Zampini 
3594e7931f94SStefano Zampini   buf_size_idxs = 0;
3595e7931f94SStefano Zampini   buf_size_vals = 0;
359628143c3dSStefano Zampini   buf_size_idxs_is = 0;
3597e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3598e7931f94SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
3599e7931f94SStefano Zampini     buf_size_vals += (PetscInt)olengths_vals[i];
360028143c3dSStefano Zampini     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
3601e7931f94SStefano Zampini   }
3602785e854fSJed Brown   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
3603785e854fSJed Brown   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
360495ecbf38SStefano Zampini   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
3605e7931f94SStefano Zampini 
3606e7931f94SStefano Zampini   /* get new tags for clean communications */
3607e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
3608e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
360928143c3dSStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
3610e7931f94SStefano Zampini 
3611e7931f94SStefano Zampini   /* allocate for requests */
3612785e854fSJed Brown   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
3613785e854fSJed Brown   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
361495ecbf38SStefano Zampini   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
3615785e854fSJed Brown   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
3616785e854fSJed Brown   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
361795ecbf38SStefano Zampini   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
3618e7931f94SStefano Zampini 
3619e7931f94SStefano Zampini   /* communications */
3620e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
3621e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
362228143c3dSStefano Zampini   ptr_idxs_is = recv_buffer_idxs_is;
3623e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3624e7931f94SStefano Zampini     source_dest = onodes[i];
3625e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
3626e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
3627e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3628e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
362928143c3dSStefano Zampini     if (nis) {
363028143c3dSStefano 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);
363128143c3dSStefano Zampini       ptr_idxs_is += olengths_idxs_is[i];
363228143c3dSStefano Zampini     }
3633e7931f94SStefano Zampini   }
3634e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) {
3635e7931f94SStefano Zampini     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
3636e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
3637e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
363828143c3dSStefano Zampini     if (nis) {
363928143c3dSStefano 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);
364028143c3dSStefano Zampini     }
3641e7931f94SStefano Zampini   }
3642e7931f94SStefano Zampini   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
3643e7931f94SStefano Zampini   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
3644e7931f94SStefano Zampini 
3645e7931f94SStefano Zampini   /* assemble new l2g map */
3646e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3647e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
36489d30be91SStefano Zampini   new_local_rows = 0;
3649e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
36509d30be91SStefano Zampini     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
3651e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3652e7931f94SStefano Zampini   }
36539d30be91SStefano Zampini   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
3654e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
36559d30be91SStefano Zampini   new_local_rows = 0;
3656e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
36579d30be91SStefano Zampini     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
36589d30be91SStefano Zampini     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
3659e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3660e7931f94SStefano Zampini   }
36619d30be91SStefano Zampini   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
36629d30be91SStefano Zampini   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
3663e7931f94SStefano Zampini   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
3664e7931f94SStefano Zampini 
3665e7931f94SStefano Zampini   /* infer new local matrix type from received local matrices type */
3666e7931f94SStefano Zampini   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
3667e7931f94SStefano 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) */
3668e7931f94SStefano Zampini   if (n_recvs) {
366928143c3dSStefano Zampini     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
3670e7931f94SStefano Zampini     ptr_idxs = recv_buffer_idxs;
3671e7931f94SStefano Zampini     for (i=0;i<n_recvs;i++) {
3672e7931f94SStefano Zampini       if ((PetscInt)new_local_type_private != *ptr_idxs) {
3673e7931f94SStefano Zampini         new_local_type_private = MATAIJ_PRIVATE;
3674e7931f94SStefano Zampini         break;
3675e7931f94SStefano Zampini       }
3676e7931f94SStefano Zampini       ptr_idxs += olengths_idxs[i];
3677e7931f94SStefano Zampini     }
3678e7931f94SStefano Zampini     switch (new_local_type_private) {
367928143c3dSStefano Zampini       case MATDENSE_PRIVATE:
368028143c3dSStefano Zampini         if (n_recvs>1) { /* subassembling of dense matrices does not give a dense matrix! */
3681e7931f94SStefano Zampini           new_local_type = MATSEQAIJ;
3682e7931f94SStefano Zampini           bs = 1;
368328143c3dSStefano Zampini         } else { /* if I receive only 1 dense matrix */
368428143c3dSStefano Zampini           new_local_type = MATSEQDENSE;
368528143c3dSStefano Zampini           bs = 1;
368628143c3dSStefano Zampini         }
3687e7931f94SStefano Zampini         break;
3688e7931f94SStefano Zampini       case MATAIJ_PRIVATE:
3689e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
3690e7931f94SStefano Zampini         bs = 1;
3691e7931f94SStefano Zampini         break;
3692e7931f94SStefano Zampini       case MATBAIJ_PRIVATE:
3693e7931f94SStefano Zampini         new_local_type = MATSEQBAIJ;
3694e7931f94SStefano Zampini         break;
3695e7931f94SStefano Zampini       case MATSBAIJ_PRIVATE:
3696e7931f94SStefano Zampini         new_local_type = MATSEQSBAIJ;
3697e7931f94SStefano Zampini         break;
3698e7931f94SStefano Zampini       default:
36999d30be91SStefano Zampini         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,__FUNCT__);
3700e7931f94SStefano Zampini         break;
3701e7931f94SStefano Zampini     }
370228143c3dSStefano Zampini   } else { /* by default, new_local_type is seqdense */
370328143c3dSStefano Zampini     new_local_type = MATSEQDENSE;
370428143c3dSStefano Zampini     bs = 1;
3705e7931f94SStefano Zampini   }
3706e7931f94SStefano Zampini 
370770cf5478SStefano Zampini   /* create MATIS object if needed */
370870cf5478SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
3709e7931f94SStefano Zampini     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
371028143c3dSStefano Zampini     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,mat_n);CHKERRQ(ierr);
371170cf5478SStefano Zampini   } else {
371270cf5478SStefano Zampini     /* it also destroys the local matrices */
371370cf5478SStefano Zampini     ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
371470cf5478SStefano Zampini   }
371570cf5478SStefano Zampini   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
3716e7931f94SStefano Zampini   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
37179d30be91SStefano Zampini 
37189d30be91SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
37199d30be91SStefano Zampini 
37209d30be91SStefano Zampini   /* Global to local map of received indices */
37219d30be91SStefano Zampini   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
37229d30be91SStefano Zampini   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
37239d30be91SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
37249d30be91SStefano Zampini 
37259d30be91SStefano Zampini   /* restore attributes -> type of incoming data and its size */
37269d30be91SStefano Zampini   buf_size_idxs = 0;
37279d30be91SStefano Zampini   for (i=0;i<n_recvs;i++) {
37289d30be91SStefano Zampini     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
37299d30be91SStefano Zampini     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
37309d30be91SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
37319d30be91SStefano Zampini   }
37329d30be91SStefano Zampini   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
37339d30be91SStefano Zampini 
37349d30be91SStefano Zampini   /* set preallocation */
37359d30be91SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
37369d30be91SStefano Zampini   if (!newisdense) {
37379d30be91SStefano Zampini     PetscInt *new_local_nnz=0;
37389d30be91SStefano Zampini 
37399d30be91SStefano Zampini     ptr_vals = recv_buffer_vals;
37409d30be91SStefano Zampini     ptr_idxs = recv_buffer_idxs_local;
37419d30be91SStefano Zampini     if (n_recvs) {
37429d30be91SStefano Zampini       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
37439d30be91SStefano Zampini     }
37449d30be91SStefano Zampini     for (i=0;i<n_recvs;i++) {
37459d30be91SStefano Zampini       PetscInt j;
37469d30be91SStefano Zampini       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
37479d30be91SStefano Zampini         for (j=0;j<*(ptr_idxs+1);j++) {
37489d30be91SStefano Zampini           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
37499d30be91SStefano Zampini         }
37509d30be91SStefano Zampini       } else {
37519d30be91SStefano Zampini         /* TODO */
37529d30be91SStefano Zampini       }
37539d30be91SStefano Zampini       ptr_idxs += olengths_idxs[i];
37549d30be91SStefano Zampini     }
37559d30be91SStefano Zampini     if (new_local_nnz) {
37569d30be91SStefano Zampini       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
37579d30be91SStefano Zampini       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
37589d30be91SStefano Zampini       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
37599d30be91SStefano Zampini       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
37609d30be91SStefano Zampini       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
37619d30be91SStefano Zampini       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
37629d30be91SStefano Zampini     } else {
37639d30be91SStefano Zampini       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
37649d30be91SStefano Zampini     }
37659d30be91SStefano Zampini     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
37669d30be91SStefano Zampini   } else {
37679d30be91SStefano Zampini     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
37689d30be91SStefano Zampini   }
3769e7931f94SStefano Zampini 
3770e7931f94SStefano Zampini   /* set values */
3771e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
37729d30be91SStefano Zampini   ptr_idxs = recv_buffer_idxs_local;
3773e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3774e7931f94SStefano Zampini     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
3775e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
37769d30be91SStefano Zampini       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
3777e7931f94SStefano Zampini       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3778e7931f94SStefano Zampini       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3779e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
378028143c3dSStefano Zampini     } else {
378128143c3dSStefano Zampini       /* TODO */
3782e7931f94SStefano Zampini     }
3783e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3784e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
3785e7931f94SStefano Zampini   }
3786e7931f94SStefano Zampini   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3787e7931f94SStefano Zampini   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
378870cf5478SStefano Zampini   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
378970cf5478SStefano Zampini   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
37909d30be91SStefano Zampini   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
37919d30be91SStefano Zampini   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
3792e7931f94SStefano Zampini 
3793dfd14d43SStefano Zampini #if 0
379428143c3dSStefano Zampini   if (!restrict_comm) { /* check */
3795e7931f94SStefano Zampini     Vec       lvec,rvec;
3796e7931f94SStefano Zampini     PetscReal infty_error;
3797e7931f94SStefano Zampini 
37982a7a6963SBarry Smith     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
3799e7931f94SStefano Zampini     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
3800e7931f94SStefano Zampini     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
3801e7931f94SStefano Zampini     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
380270cf5478SStefano Zampini     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
3803e7931f94SStefano Zampini     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3804e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
3805e7931f94SStefano Zampini     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
3806e7931f94SStefano Zampini     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
3807e7931f94SStefano Zampini   }
380828143c3dSStefano Zampini #endif
3809e7931f94SStefano Zampini 
381028143c3dSStefano Zampini   /* assemble new additional is (if any) */
381128143c3dSStefano Zampini   if (nis) {
381228143c3dSStefano Zampini     PetscInt **temp_idxs,*count_is,j,psum;
381328143c3dSStefano Zampini 
381428143c3dSStefano Zampini     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3815854ce69bSBarry Smith     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
381628143c3dSStefano Zampini     ptr_idxs = recv_buffer_idxs_is;
381728143c3dSStefano Zampini     psum = 0;
381828143c3dSStefano Zampini     for (i=0;i<n_recvs;i++) {
381928143c3dSStefano Zampini       for (j=0;j<nis;j++) {
382028143c3dSStefano Zampini         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
382128143c3dSStefano Zampini         count_is[j] += plen; /* increment counting of buffer for j-th IS */
382228143c3dSStefano Zampini         psum += plen;
382328143c3dSStefano Zampini         ptr_idxs += plen+1; /* shift pointer to received data */
382428143c3dSStefano Zampini       }
382528143c3dSStefano Zampini     }
3826854ce69bSBarry Smith     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
3827854ce69bSBarry Smith     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
382828143c3dSStefano Zampini     for (i=1;i<nis;i++) {
382928143c3dSStefano Zampini       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
383028143c3dSStefano Zampini     }
383128143c3dSStefano Zampini     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
383228143c3dSStefano Zampini     ptr_idxs = recv_buffer_idxs_is;
383328143c3dSStefano Zampini     for (i=0;i<n_recvs;i++) {
383428143c3dSStefano Zampini       for (j=0;j<nis;j++) {
383528143c3dSStefano Zampini         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
383628143c3dSStefano Zampini         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
383728143c3dSStefano Zampini         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
383828143c3dSStefano Zampini         ptr_idxs += plen+1; /* shift pointer to received data */
383928143c3dSStefano Zampini       }
384028143c3dSStefano Zampini     }
384128143c3dSStefano Zampini     for (i=0;i<nis;i++) {
384228143c3dSStefano Zampini       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
384328143c3dSStefano Zampini       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
384428143c3dSStefano Zampini       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
384528143c3dSStefano Zampini     }
384628143c3dSStefano Zampini     ierr = PetscFree(count_is);CHKERRQ(ierr);
384728143c3dSStefano Zampini     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
384828143c3dSStefano Zampini     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
384928143c3dSStefano Zampini   }
3850e7931f94SStefano Zampini   /* free workspace */
385128143c3dSStefano Zampini   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
3852e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3853e7931f94SStefano Zampini   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
3854e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3855e7931f94SStefano Zampini   if (isdense) {
3856e7931f94SStefano Zampini     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
3857e7931f94SStefano Zampini     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
3858e7931f94SStefano Zampini   } else {
3859e7931f94SStefano Zampini     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
3860e7931f94SStefano Zampini   }
386128143c3dSStefano Zampini   if (nis) {
386228143c3dSStefano Zampini     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
386328143c3dSStefano Zampini     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
386428143c3dSStefano Zampini   }
3865e7931f94SStefano Zampini   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
3866e7931f94SStefano Zampini   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
386728143c3dSStefano Zampini   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
3868e7931f94SStefano Zampini   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
3869e7931f94SStefano Zampini   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
387028143c3dSStefano Zampini   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
3871e7931f94SStefano Zampini   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
3872e7931f94SStefano Zampini   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
3873e7931f94SStefano Zampini   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
3874e7931f94SStefano Zampini   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
3875e7931f94SStefano Zampini   ierr = PetscFree(onodes);CHKERRQ(ierr);
387628143c3dSStefano Zampini   if (nis) {
387728143c3dSStefano Zampini     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
387828143c3dSStefano Zampini     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
387928143c3dSStefano Zampini     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
388028143c3dSStefano Zampini   }
388128143c3dSStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
388228143c3dSStefano Zampini   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
388328143c3dSStefano Zampini     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
388428143c3dSStefano Zampini     for (i=0;i<nis;i++) {
388528143c3dSStefano Zampini       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
388628143c3dSStefano Zampini     }
388728143c3dSStefano Zampini   }
3888e7931f94SStefano Zampini   PetscFunctionReturn(0);
3889e7931f94SStefano Zampini }
3890a57a6d2fSStefano Zampini 
389112edc857SStefano Zampini /* temporary hack into ksp private data structure */
389212edc857SStefano Zampini #include <petsc-private/kspimpl.h>
389312edc857SStefano Zampini 
3894c8587f34SStefano Zampini #undef __FUNCT__
3895c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
3896c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
3897c8587f34SStefano Zampini {
3898c8587f34SStefano Zampini   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
3899c8587f34SStefano Zampini   PC_IS                  *pcis = (PC_IS*)pc->data;
390020a2ab83SStefano Zampini   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
39019881197aSStefano Zampini   MatNullSpace           CoarseNullSpace=NULL;
390220a2ab83SStefano Zampini   ISLocalToGlobalMapping coarse_islg;
39036e683305SStefano Zampini   IS                     coarse_is,*isarray;
39046e683305SStefano Zampini   PetscInt               i,im_active=-1,active_procs=-1;
39056e683305SStefano Zampini   PetscInt               nis,nisdofs,nisneu;
3906f9eb5b7dSStefano Zampini   PC                     pc_temp;
3907c8587f34SStefano Zampini   PCType                 coarse_pc_type;
3908c8587f34SStefano Zampini   KSPType                coarse_ksp_type;
3909f9eb5b7dSStefano Zampini   PetscBool              multilevel_requested,multilevel_allowed;
39104f3a063dSStefano Zampini   PetscBool              isredundant,isbddc,isnn,coarse_reuse;
39116e683305SStefano Zampini   Mat                    t_coarse_mat_is;
39126e683305SStefano Zampini   PetscInt               void_procs,ncoarse_ml,ncoarse_ds,ncoarse;
39136e683305SStefano Zampini   PetscMPIInt            all_procs;
391474e2c79eSStefano Zampini   PetscBool              csin_ml,csin_ds,csin,csin_type_simple,redist;
391568457ee5SStefano Zampini   PetscBool              compute_vecs = PETSC_FALSE;
391622bc73bbSStefano Zampini   PetscScalar            *array;
39179881197aSStefano Zampini   PetscErrorCode         ierr;
3918fdc09c96SStefano Zampini 
3919c8587f34SStefano Zampini   PetscFunctionBegin;
3920c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
392168457ee5SStefano 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 */
3922fa7f1dd8SStefano Zampini     PetscInt ocoarse_size;
39235a75c04eSSatish Balay     compute_vecs = PETSC_TRUE;
3924fa7f1dd8SStefano Zampini     ocoarse_size = pcbddc->coarse_size;
3925f4ddd8eeSStefano Zampini     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3926f4ddd8eeSStefano Zampini     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
3927f4ddd8eeSStefano Zampini     /* see if we can avoid some work */
3928fa7f1dd8SStefano Zampini     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
3929fa7f1dd8SStefano Zampini       if (ocoarse_size != pcbddc->coarse_size) { /* ...but with different size, so reset it and set reuse flag to false */
3930727cdba6SStefano Zampini         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3931fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_FALSE;
3932fa7f1dd8SStefano Zampini       } else { /* we can safely reuse already computed coarse matrix */
3933fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_TRUE;
3934f4ddd8eeSStefano Zampini       }
3935fa7f1dd8SStefano Zampini     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
3936fa7f1dd8SStefano Zampini       coarse_reuse = PETSC_FALSE;
3937f4ddd8eeSStefano Zampini     }
393870cf5478SStefano Zampini     /* reset any subassembling information */
393970cf5478SStefano Zampini     ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
39406e683305SStefano Zampini     ierr = ISDestroy(&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
39416e683305SStefano Zampini   } else { /* primal space is unchanged, so we can reuse coarse matrix */
3942fa7f1dd8SStefano Zampini     coarse_reuse = PETSC_TRUE;
3943f4ddd8eeSStefano Zampini   }
3944c8587f34SStefano Zampini 
39456e683305SStefano Zampini   /* count "active" (i.e. with positive local size) and "void" processes */
39462b510759SStefano Zampini   im_active = !!(pcis->n);
39472b510759SStefano Zampini   ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
39486e683305SStefano Zampini   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&all_procs);CHKERRQ(ierr);
39496e683305SStefano Zampini   void_procs = all_procs-active_procs;
39506e683305SStefano Zampini   csin_type_simple = PETSC_TRUE;
395174e2c79eSStefano Zampini   redist = PETSC_FALSE;
395222bc73bbSStefano Zampini   if (pcbddc->current_level && void_procs) {
39536e683305SStefano Zampini     csin_ml = PETSC_TRUE;
39546e683305SStefano Zampini     ncoarse_ml = void_procs;
3955779c1cceSStefano Zampini     /* it has no sense to redistribute on a set of processors larger than the number of active processes */
3956779c1cceSStefano Zampini     if (pcbddc->redistribute_coarse > 0 && pcbddc->redistribute_coarse < active_procs) {
395718a45a71SStefano Zampini       csin_ds = PETSC_TRUE;
395818a45a71SStefano Zampini       ncoarse_ds = pcbddc->redistribute_coarse;
395918a45a71SStefano Zampini       redist = PETSC_TRUE;
396018a45a71SStefano Zampini     } else {
39616e683305SStefano Zampini       csin_ds = PETSC_TRUE;
3962779c1cceSStefano Zampini       ncoarse_ds = active_procs;
3963779c1cceSStefano Zampini       redist = PETSC_TRUE;
396418a45a71SStefano Zampini     }
39656e683305SStefano Zampini   } else {
39666e683305SStefano Zampini     csin_ml = PETSC_FALSE;
39676e683305SStefano Zampini     ncoarse_ml = all_procs;
39686e683305SStefano Zampini     if (void_procs) {
39696e683305SStefano Zampini       csin_ds = PETSC_TRUE;
39706e683305SStefano Zampini       ncoarse_ds = void_procs;
39716e683305SStefano Zampini       csin_type_simple = PETSC_FALSE;
39726e683305SStefano Zampini     } else {
3973779c1cceSStefano Zampini       if (pcbddc->redistribute_coarse > 0 && pcbddc->redistribute_coarse < all_procs) {
397474e2c79eSStefano Zampini         csin_ds = PETSC_TRUE;
397574e2c79eSStefano Zampini         ncoarse_ds = pcbddc->redistribute_coarse;
397674e2c79eSStefano Zampini         redist = PETSC_TRUE;
397774e2c79eSStefano Zampini       } else {
39786e683305SStefano Zampini         csin_ds = PETSC_FALSE;
39796e683305SStefano Zampini         ncoarse_ds = all_procs;
39806e683305SStefano Zampini       }
39816e683305SStefano Zampini     }
398274e2c79eSStefano Zampini   }
39836e683305SStefano Zampini 
39846e683305SStefano Zampini   /*
39856e683305SStefano Zampini     test if we can go multilevel: three conditions must be satisfied:
39866e683305SStefano Zampini     - we have not exceeded the number of levels requested
39876e683305SStefano Zampini     - we can actually subassemble the active processes
39886e683305SStefano Zampini     - we can find a suitable number of MPI processes where we can place the subassembled problem
39896e683305SStefano Zampini   */
39906e683305SStefano Zampini   multilevel_allowed = PETSC_FALSE;
39916e683305SStefano Zampini   multilevel_requested = PETSC_FALSE;
39926e683305SStefano Zampini   if (pcbddc->current_level < pcbddc->max_levels) {
39936e683305SStefano Zampini     multilevel_requested = PETSC_TRUE;
39946e683305SStefano Zampini     if (active_procs/pcbddc->coarsening_ratio < 2 || ncoarse_ml/pcbddc->coarsening_ratio < 2) {
3995f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_FALSE;
39962b510759SStefano Zampini     } else {
3997f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_TRUE;
3998c8587f34SStefano Zampini     }
3999c8587f34SStefano Zampini   }
40006e683305SStefano Zampini   /* determine number of process partecipating to coarse solver */
40016e683305SStefano Zampini   if (multilevel_allowed) {
40026e683305SStefano Zampini     ncoarse = ncoarse_ml;
40036e683305SStefano Zampini     csin = csin_ml;
400458da7f69SStefano Zampini     redist = PETSC_FALSE;
40056e683305SStefano Zampini   } else {
40066e683305SStefano Zampini     ncoarse = ncoarse_ds;
40076e683305SStefano Zampini     csin = csin_ds;
40086e683305SStefano Zampini   }
4009e7931f94SStefano Zampini 
4010abbbba34SStefano Zampini   /* creates temporary l2gmap and IS for coarse indexes */
4011abbbba34SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
4012abbbba34SStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
4013abbbba34SStefano Zampini 
4014abbbba34SStefano Zampini   /* creates temporary MATIS object for coarse matrix */
401522bc73bbSStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
401622bc73bbSStefano Zampini   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
401722bc73bbSStefano Zampini   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
401822bc73bbSStefano Zampini   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
4019b9b85e73SStefano Zampini #if 0
4020b9b85e73SStefano Zampini   {
4021b9b85e73SStefano Zampini     PetscViewer viewer;
4022b9b85e73SStefano Zampini     char filename[256];
4023b9b85e73SStefano Zampini     sprintf(filename,"local_coarse_mat%d.m",PetscGlobalRank);
4024b9b85e73SStefano Zampini     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4025b9b85e73SStefano Zampini     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4026b9b85e73SStefano Zampini     ierr = MatView(coarse_submat_dense,viewer);CHKERRQ(ierr);
4027b9b85e73SStefano Zampini     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4028b9b85e73SStefano Zampini   }
4029b9b85e73SStefano Zampini #endif
40306e683305SStefano 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);
40316e683305SStefano Zampini   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
40326e683305SStefano Zampini   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
40336e683305SStefano Zampini   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4034abbbba34SStefano Zampini   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
4035abbbba34SStefano Zampini 
40366e683305SStefano Zampini   /* compute dofs splitting and neumann boundaries for coarse dofs */
40376e683305SStefano Zampini   if (multilevel_allowed && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal) ) { /* protects from unneded computations */
40386e683305SStefano Zampini     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
40396e683305SStefano Zampini     const PetscInt         *idxs;
40406e683305SStefano Zampini     ISLocalToGlobalMapping tmap;
40416e683305SStefano Zampini 
40426e683305SStefano Zampini     /* create map between primal indices (in local representative ordering) and local primal numbering */
40430be93d54SStefano Zampini     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
40446e683305SStefano Zampini     /* allocate space for temporary storage */
4045854ce69bSBarry Smith     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
4046854ce69bSBarry Smith     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
40476e683305SStefano Zampini     /* allocate for IS array */
40486e683305SStefano Zampini     nisdofs = pcbddc->n_ISForDofsLocal;
40496e683305SStefano Zampini     nisneu = !!pcbddc->NeumannBoundariesLocal;
40506e683305SStefano Zampini     nis = nisdofs + nisneu;
4051854ce69bSBarry Smith     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
40526e683305SStefano Zampini     /* dofs splitting */
40536e683305SStefano Zampini     for (i=0;i<nisdofs;i++) {
40546e683305SStefano Zampini       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
40556e683305SStefano Zampini       ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
40566e683305SStefano Zampini       ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
40576e683305SStefano Zampini       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
40586e683305SStefano Zampini       ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
40596e683305SStefano Zampini       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
40606e683305SStefano Zampini       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pcbddc->ISForDofsLocal[i]),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
40616e683305SStefano Zampini       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
40626e683305SStefano Zampini     }
40636e683305SStefano Zampini     /* neumann boundaries */
40646e683305SStefano Zampini     if (pcbddc->NeumannBoundariesLocal) {
40656e683305SStefano Zampini       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
40666e683305SStefano Zampini       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
40676e683305SStefano Zampini       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
40686e683305SStefano Zampini       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
40696e683305SStefano Zampini       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
40706e683305SStefano Zampini       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
40716e683305SStefano Zampini       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pcbddc->NeumannBoundariesLocal),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
40726e683305SStefano Zampini       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
40736e683305SStefano Zampini     }
40746e683305SStefano Zampini     /* free memory */
40756e683305SStefano Zampini     ierr = PetscFree(tidxs);CHKERRQ(ierr);
40766e683305SStefano Zampini     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
40776e683305SStefano Zampini     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
40786e683305SStefano Zampini   } else {
40796e683305SStefano Zampini     nis = 0;
40806e683305SStefano Zampini     nisdofs = 0;
40816e683305SStefano Zampini     nisneu = 0;
40826e683305SStefano Zampini     isarray = NULL;
40836e683305SStefano Zampini   }
40846e683305SStefano Zampini   /* destroy no longer needed map */
40856e683305SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
40866e683305SStefano Zampini 
40876e683305SStefano Zampini   /* restrict on coarse candidates (if needed) */
40886e683305SStefano Zampini   coarse_mat_is = NULL;
40896e683305SStefano Zampini   if (csin) {
40906e683305SStefano Zampini     if (!pcbddc->coarse_subassembling_init ) { /* creates subassembling init pattern if not present */
409174e2c79eSStefano Zampini       if (redist) {
409274e2c79eSStefano Zampini         PetscMPIInt rank;
4093779c1cceSStefano Zampini         PetscInt    spc,n_spc_p1,dest[1],destsize;
409474e2c79eSStefano Zampini 
409574e2c79eSStefano Zampini         ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
409658da7f69SStefano Zampini         spc = active_procs/ncoarse;
409758da7f69SStefano Zampini         n_spc_p1 = active_procs%ncoarse;
4098779c1cceSStefano Zampini         if (im_active) {
4099779c1cceSStefano Zampini           destsize = 1;
410074e2c79eSStefano Zampini           if (rank > n_spc_p1*(spc+1)-1) {
410174e2c79eSStefano Zampini             dest[0] = n_spc_p1+(rank-(n_spc_p1*(spc+1)))/spc;
410274e2c79eSStefano Zampini           } else {
410374e2c79eSStefano Zampini             dest[0] = rank/(spc+1);
410474e2c79eSStefano Zampini           }
410574e2c79eSStefano Zampini         } else {
4106779c1cceSStefano Zampini           destsize = 0;
41076e683305SStefano Zampini         }
4108779c1cceSStefano Zampini         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),destsize,dest,PETSC_COPY_VALUES,&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
4109779c1cceSStefano Zampini       } else if (csin_type_simple) {
41106e683305SStefano Zampini         PetscMPIInt rank;
41116e683305SStefano Zampini         PetscInt    issize,isidx;
4112779c1cceSStefano Zampini 
41136e683305SStefano Zampini         ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
41146e683305SStefano Zampini         if (im_active) {
41156e683305SStefano Zampini           issize = 1;
41166e683305SStefano Zampini           isidx = (PetscInt)rank;
41176e683305SStefano Zampini         } else {
41186e683305SStefano Zampini           issize = 0;
41196e683305SStefano Zampini           isidx = -1;
41206e683305SStefano Zampini         }
41216e683305SStefano Zampini         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),issize,&isidx,PETSC_COPY_VALUES,&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
4122779c1cceSStefano Zampini       } else { /* get a suitable subassembling pattern from MATIS code */
41236e683305SStefano Zampini         ierr = MatISGetSubassemblingPattern(t_coarse_mat_is,ncoarse,PETSC_TRUE,&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
41246e683305SStefano Zampini       }
4125779c1cceSStefano Zampini 
4126779c1cceSStefano Zampini       /* we need to shift on coarse candidates either if we are not redistributing or we are redistributing and we have enough void processes */
4127779c1cceSStefano Zampini       if (!redist || ncoarse <= void_procs) {
4128779c1cceSStefano Zampini         PetscInt ncoarse_cand,tissize,*nisindices;
4129779c1cceSStefano Zampini         PetscInt *coarse_candidates;
4130779c1cceSStefano Zampini         const PetscInt* tisindices;
4131779c1cceSStefano Zampini 
4132779c1cceSStefano Zampini         /* get coarse candidates' ranks in pc communicator */
4133779c1cceSStefano Zampini         ierr = PetscMalloc1(all_procs,&coarse_candidates);CHKERRQ(ierr);
4134779c1cceSStefano Zampini         ierr = MPI_Allgather(&im_active,1,MPIU_INT,coarse_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4135779c1cceSStefano Zampini         for (i=0,ncoarse_cand=0;i<all_procs;i++) {
4136779c1cceSStefano Zampini           if (!coarse_candidates[i]) {
4137779c1cceSStefano Zampini             coarse_candidates[ncoarse_cand++]=i;
4138779c1cceSStefano Zampini           }
4139779c1cceSStefano Zampini         }
4140779c1cceSStefano Zampini         if (ncoarse_cand < ncoarse) SETERRQ2(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen! %d < %d",ncoarse_cand,ncoarse);
4141779c1cceSStefano Zampini 
4142779c1cceSStefano Zampini 
41436e683305SStefano Zampini         if (pcbddc->dbg_flag) {
41446e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
41456e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Subassembling pattern init (before shift)\n");CHKERRQ(ierr);
41466e683305SStefano Zampini           ierr = ISView(pcbddc->coarse_subassembling_init,pcbddc->dbg_viewer);CHKERRQ(ierr);
41476e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse candidates\n");CHKERRQ(ierr);
4148779c1cceSStefano Zampini           for (i=0;i<ncoarse_cand;i++) {
41496e683305SStefano Zampini             ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"%d ",coarse_candidates[i]);CHKERRQ(ierr);
41506e683305SStefano Zampini           }
41516e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"\n");CHKERRQ(ierr);
41526e683305SStefano Zampini           ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
41536e683305SStefano Zampini         }
41546e683305SStefano Zampini         /* shift the pattern on coarse candidates */
41556e683305SStefano Zampini         ierr = ISGetLocalSize(pcbddc->coarse_subassembling_init,&tissize);CHKERRQ(ierr);
41566e683305SStefano Zampini         ierr = ISGetIndices(pcbddc->coarse_subassembling_init,&tisindices);CHKERRQ(ierr);
4157854ce69bSBarry Smith         ierr = PetscMalloc1(tissize,&nisindices);CHKERRQ(ierr);
41586e683305SStefano Zampini         for (i=0;i<tissize;i++) nisindices[i] = coarse_candidates[tisindices[i]];
41596e683305SStefano Zampini         ierr = ISRestoreIndices(pcbddc->coarse_subassembling_init,&tisindices);CHKERRQ(ierr);
41606e683305SStefano Zampini         ierr = ISGeneralSetIndices(pcbddc->coarse_subassembling_init,tissize,nisindices,PETSC_OWN_POINTER);CHKERRQ(ierr);
41616e683305SStefano Zampini         ierr = PetscFree(coarse_candidates);CHKERRQ(ierr);
41626e683305SStefano Zampini       }
41636e683305SStefano Zampini       if (pcbddc->dbg_flag) {
41646e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
41656e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Subassembling pattern init\n");CHKERRQ(ierr);
41666e683305SStefano Zampini         ierr = ISView(pcbddc->coarse_subassembling_init,pcbddc->dbg_viewer);CHKERRQ(ierr);
41676e683305SStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
41686e683305SStefano Zampini       }
4169779c1cceSStefano Zampini     }
41706e683305SStefano Zampini     /* get temporary coarse mat in IS format restricted on coarse procs (plus additional index sets of isarray) */
41716e683305SStefano Zampini     ierr = MatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling_init,0,PETSC_TRUE,MAT_INITIAL_MATRIX,&coarse_mat_is,nis,isarray);CHKERRQ(ierr);
41726e683305SStefano Zampini   } else {
41736e683305SStefano Zampini     if (pcbddc->dbg_flag) {
41746e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
41756e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Subassembling pattern init not needed\n");CHKERRQ(ierr);
41766e683305SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
41776e683305SStefano Zampini     }
41786e683305SStefano Zampini     ierr = PetscObjectReference((PetscObject)t_coarse_mat_is);CHKERRQ(ierr);
41796e683305SStefano Zampini     coarse_mat_is = t_coarse_mat_is;
41806e683305SStefano Zampini   }
41816e683305SStefano Zampini 
41826e683305SStefano Zampini   /* create local to global scatters for coarse problem */
418368457ee5SStefano Zampini   if (compute_vecs) {
41846e683305SStefano Zampini     PetscInt lrows;
41856e683305SStefano Zampini     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
41866e683305SStefano Zampini     if (coarse_mat_is) {
41876e683305SStefano Zampini       ierr = MatGetLocalSize(coarse_mat_is,&lrows,NULL);CHKERRQ(ierr);
41886e683305SStefano Zampini     } else {
41896e683305SStefano Zampini       lrows = 0;
41906e683305SStefano Zampini     }
41916e683305SStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
41926e683305SStefano Zampini     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
41936e683305SStefano Zampini     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
41946e683305SStefano Zampini     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
41956e683305SStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
41966e683305SStefano Zampini   }
41976e683305SStefano Zampini   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
41986e683305SStefano Zampini   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
4199c8587f34SStefano Zampini 
4200f9eb5b7dSStefano Zampini   /* set defaults for coarse KSP and PC */
4201f9eb5b7dSStefano Zampini   if (multilevel_allowed) {
4202f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPRICHARDSON;
4203f9eb5b7dSStefano Zampini     coarse_pc_type = PCBDDC;
4204f9eb5b7dSStefano Zampini   } else {
4205f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPPREONLY;
4206f9eb5b7dSStefano Zampini     coarse_pc_type = PCREDUNDANT;
4207c8587f34SStefano Zampini   }
4208c8587f34SStefano Zampini 
42096e683305SStefano Zampini   /* print some info if requested */
42106e683305SStefano Zampini   if (pcbddc->dbg_flag) {
42116e683305SStefano Zampini     if (!multilevel_allowed) {
42126e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
42136e683305SStefano Zampini       if (multilevel_requested) {
42146e683305SStefano 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);
42156e683305SStefano Zampini       } else if (pcbddc->max_levels) {
42166e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
42176e683305SStefano Zampini       }
42186e683305SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
42196e683305SStefano Zampini     }
42206e683305SStefano Zampini   }
42216e683305SStefano Zampini 
4222f9eb5b7dSStefano Zampini   /* create the coarse KSP object only once with defaults */
42236e683305SStefano Zampini   if (coarse_mat_is) {
42246e683305SStefano Zampini     MatReuse coarse_mat_reuse;
42256a1308c2SStefano Zampini     PetscViewer dbg_viewer = NULL;
42266e683305SStefano Zampini     if (pcbddc->dbg_flag) {
42276e683305SStefano Zampini       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat_is));
42286e683305SStefano Zampini       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
42296e683305SStefano Zampini     }
4230f9eb5b7dSStefano Zampini     if (!pcbddc->coarse_ksp) {
4231312be037SStefano Zampini       char prefix[256],str_level[16];
4232e604994aSStefano Zampini       size_t len;
42336e683305SStefano Zampini       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat_is),&pcbddc->coarse_ksp);CHKERRQ(ierr);
4234c8587f34SStefano Zampini       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
4235f9eb5b7dSStefano Zampini       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
42365f76c7aeSStefano Zampini       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat_is,coarse_mat_is);CHKERRQ(ierr);
4237c8587f34SStefano Zampini       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
42386e683305SStefano Zampini       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
4239c8587f34SStefano Zampini       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
4240c8587f34SStefano Zampini       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
42413e3c6dadSStefano Zampini       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4242e604994aSStefano Zampini       /* prefix */
4243e604994aSStefano Zampini       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
4244e604994aSStefano Zampini       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
4245e604994aSStefano Zampini       if (!pcbddc->current_level) {
4246e604994aSStefano Zampini         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4247e604994aSStefano Zampini         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
4248c8587f34SStefano Zampini       } else {
4249e604994aSStefano Zampini         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
4250312be037SStefano Zampini         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
4251312be037SStefano Zampini         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
425234d6797cSStefano Zampini         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4253312be037SStefano Zampini         sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
4254e604994aSStefano Zampini         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
4255e604994aSStefano Zampini       }
4256e604994aSStefano Zampini       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
42573e3c6dadSStefano Zampini       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
42583e3c6dadSStefano Zampini       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
42593e3c6dadSStefano Zampini       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
42603e3c6dadSStefano Zampini       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
4261f9eb5b7dSStefano Zampini       /* allow user customization */
4262f9eb5b7dSStefano Zampini       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
42633e3c6dadSStefano Zampini     }
42643e3c6dadSStefano Zampini     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
42653e3c6dadSStefano Zampini     if (nisdofs) {
42663e3c6dadSStefano Zampini       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
42673e3c6dadSStefano Zampini       for (i=0;i<nisdofs;i++) {
42683e3c6dadSStefano Zampini         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
42693e3c6dadSStefano Zampini       }
42703e3c6dadSStefano Zampini     }
42713e3c6dadSStefano Zampini     if (nisneu) {
42723e3c6dadSStefano Zampini       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
42733e3c6dadSStefano Zampini       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
4274312be037SStefano Zampini     }
4275f9eb5b7dSStefano Zampini 
4276f9eb5b7dSStefano Zampini     /* get some info after set from options */
4277f9eb5b7dSStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
4278f9eb5b7dSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
4279f9eb5b7dSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
42804f3a063dSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
42816e683305SStefano Zampini     if (isbddc && !multilevel_allowed) { /* multilevel can only be requested via pc_bddc_set_levels */
4282f9eb5b7dSStefano Zampini       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
4283f9eb5b7dSStefano Zampini       isbddc = PETSC_FALSE;
4284f9eb5b7dSStefano Zampini     }
42854f3a063dSStefano Zampini     if (isredundant) {
42864f3a063dSStefano Zampini       KSP inner_ksp;
42874f3a063dSStefano Zampini       PC inner_pc;
42884f3a063dSStefano Zampini       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
42894f3a063dSStefano Zampini       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
42904f3a063dSStefano Zampini       ierr = PCFactorSetReuseFill(inner_pc,PETSC_TRUE);CHKERRQ(ierr);
42914f3a063dSStefano Zampini     }
4292f9eb5b7dSStefano Zampini 
4293f9eb5b7dSStefano Zampini     /* assemble coarse matrix */
4294fa7f1dd8SStefano Zampini     if (coarse_reuse) {
429581d9aea3SBarry Smith       ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
4296fa7f1dd8SStefano Zampini       ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
42976e683305SStefano Zampini       coarse_mat_reuse = MAT_REUSE_MATRIX;
4298fa7f1dd8SStefano Zampini     } else {
42996e683305SStefano Zampini       coarse_mat_reuse = MAT_INITIAL_MATRIX;
4300fa7f1dd8SStefano Zampini     }
4301c8587f34SStefano Zampini     if (isbddc || isnn) {
430222bc73bbSStefano Zampini       if (pcbddc->coarsening_ratio > 1) {
430370cf5478SStefano Zampini         if (!pcbddc->coarse_subassembling) { /* subassembling info is not present */
430428143c3dSStefano Zampini           ierr = MatISGetSubassemblingPattern(coarse_mat_is,active_procs/pcbddc->coarsening_ratio,PETSC_TRUE,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
430522b6e8a2SStefano Zampini           if (pcbddc->dbg_flag) {
43066e683305SStefano Zampini             ierr = PetscViewerASCIIPrintf(dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
43076e683305SStefano Zampini             ierr = PetscViewerASCIIPrintf(dbg_viewer,"Subassembling pattern\n");CHKERRQ(ierr);
43086e683305SStefano Zampini             ierr = ISView(pcbddc->coarse_subassembling,dbg_viewer);CHKERRQ(ierr);
43096e683305SStefano Zampini             ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
431022b6e8a2SStefano Zampini           }
431170cf5478SStefano Zampini         }
43126e683305SStefano Zampini         ierr = MatISSubassemble(coarse_mat_is,pcbddc->coarse_subassembling,0,PETSC_FALSE,coarse_mat_reuse,&coarse_mat,0,NULL);CHKERRQ(ierr);
431370cf5478SStefano Zampini       } else {
431422bc73bbSStefano Zampini         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
431522bc73bbSStefano Zampini         coarse_mat = coarse_mat_is;
431622bc73bbSStefano Zampini       }
431722bc73bbSStefano Zampini     } else {
43182e1e5fa4SStefano Zampini       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
4319c8587f34SStefano Zampini     }
4320c8587f34SStefano Zampini     ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
4321c8587f34SStefano Zampini 
4322c8587f34SStefano Zampini     /* propagate symmetry info to coarse matrix */
4323b9d89cd5SStefano Zampini     ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pcbddc->issym);CHKERRQ(ierr);
43245a16e3a0SStefano Zampini     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
4325c8587f34SStefano Zampini 
43266e683305SStefano Zampini     /* set operators */
43275f76c7aeSStefano Zampini     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
43286e683305SStefano Zampini     if (pcbddc->dbg_flag) {
43296e683305SStefano Zampini       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
43306e683305SStefano Zampini     }
43316e683305SStefano Zampini   } else { /* processes non partecipating to coarse solver (if any) */
43326e683305SStefano Zampini     coarse_mat = 0;
43336e683305SStefano Zampini   }
43346e683305SStefano Zampini   ierr = PetscFree(isarray);CHKERRQ(ierr);
4335b9b85e73SStefano Zampini #if 0
4336b9b85e73SStefano Zampini   {
4337b9b85e73SStefano Zampini     PetscViewer viewer;
4338b9b85e73SStefano Zampini     char filename[256];
4339b9b85e73SStefano Zampini     sprintf(filename,"coarse_mat.m");
4340b9b85e73SStefano Zampini     ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,filename,&viewer);CHKERRQ(ierr);
4341b9b85e73SStefano Zampini     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4342b9b85e73SStefano Zampini     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
4343b9b85e73SStefano Zampini     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4344b9b85e73SStefano Zampini   }
4345b9b85e73SStefano Zampini #endif
4346c8587f34SStefano Zampini 
4347c8587f34SStefano Zampini   /* Compute coarse null space (special handling by BDDC only) */
4348c8587f34SStefano Zampini   if (pcbddc->NullSpace) {
4349c8587f34SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,coarse_mat,&CoarseNullSpace);CHKERRQ(ierr);
435098a51de6SStefano Zampini   }
435198a51de6SStefano Zampini 
435298a51de6SStefano Zampini   if (pcbddc->coarse_ksp) {
435398a51de6SStefano Zampini     Vec crhs,csol;
435498a51de6SStefano Zampini     PetscBool ispreonly;
435598a51de6SStefano Zampini     if (CoarseNullSpace) {
4356c8587f34SStefano Zampini       if (isbddc) {
4357c8587f34SStefano Zampini         ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
4358c8587f34SStefano Zampini       } else {
4359c8587f34SStefano Zampini         ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
4360c8587f34SStefano Zampini       }
4361c8587f34SStefano Zampini     }
4362f9eb5b7dSStefano Zampini     /* setup coarse ksp */
4363f9eb5b7dSStefano Zampini     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
4364f347579bSStefano Zampini     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
4365f347579bSStefano Zampini     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
43666e683305SStefano Zampini     /* hack */
4367f347579bSStefano Zampini     if (!csol) {
43682a7a6963SBarry Smith       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
4369f9eb5b7dSStefano Zampini     }
4370f347579bSStefano Zampini     if (!crhs) {
43712a7a6963SBarry Smith       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
4372f347579bSStefano Zampini     }
4373cbcc2c2aSStefano Zampini     /* Check coarse problem if in debug mode or if solving with an iterative method */
4374cbcc2c2aSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
43756e683305SStefano Zampini     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
4376c8587f34SStefano Zampini       KSP       check_ksp;
43772b510759SStefano Zampini       KSPType   check_ksp_type;
4378c8587f34SStefano Zampini       PC        check_pc;
43796e683305SStefano Zampini       Vec       check_vec,coarse_vec;
43806a1308c2SStefano Zampini       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
43812b510759SStefano Zampini       PetscInt  its;
43826e683305SStefano Zampini       PetscBool compute_eigs;
43836e683305SStefano Zampini       PetscReal *eigs_r,*eigs_c;
43846e683305SStefano Zampini       PetscInt  neigs;
43858e185a42SStefano Zampini       const char *prefix;
4386c8587f34SStefano Zampini 
43872b510759SStefano Zampini       /* Create ksp object suitable for estimation of extreme eigenvalues */
43886e683305SStefano Zampini       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
438923ee1639SBarry Smith       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
4390f4ddd8eeSStefano Zampini       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
43912b510759SStefano Zampini       if (ispreonly) {
43922b510759SStefano Zampini         check_ksp_type = KSPPREONLY;
43936e683305SStefano Zampini         compute_eigs = PETSC_FALSE;
43942b510759SStefano Zampini       } else {
4395cbcc2c2aSStefano Zampini         check_ksp_type = KSPGMRES;
43966e683305SStefano Zampini         compute_eigs = PETSC_TRUE;
4397c8587f34SStefano Zampini       }
4398c8587f34SStefano Zampini       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
43996e683305SStefano Zampini       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
44006e683305SStefano Zampini       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
44016e683305SStefano Zampini       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
4402a7dc3881SStefano Zampini       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
4403a7dc3881SStefano Zampini       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
4404a7dc3881SStefano Zampini       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
4405a7dc3881SStefano Zampini       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
4406c8587f34SStefano Zampini       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
4407c8587f34SStefano Zampini       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
4408c8587f34SStefano Zampini       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
4409c8587f34SStefano Zampini       /* create random vec */
44106e683305SStefano Zampini       ierr = KSPGetSolution(pcbddc->coarse_ksp,&coarse_vec);CHKERRQ(ierr);
44116e683305SStefano Zampini       ierr = VecDuplicate(coarse_vec,&check_vec);CHKERRQ(ierr);
4412c8587f34SStefano Zampini       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
4413c8587f34SStefano Zampini       if (CoarseNullSpace) {
4414c8587f34SStefano Zampini         ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
4415c8587f34SStefano Zampini       }
44166e683305SStefano Zampini       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
4417c8587f34SStefano Zampini       /* solve coarse problem */
44186e683305SStefano Zampini       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
4419c8587f34SStefano Zampini       if (CoarseNullSpace) {
44206e683305SStefano Zampini         ierr = MatNullSpaceRemove(CoarseNullSpace,coarse_vec);CHKERRQ(ierr);
4421c8587f34SStefano Zampini       }
4422cbcc2c2aSStefano Zampini       /* set eigenvalue estimation if preonly has not been requested */
44236e683305SStefano Zampini       if (compute_eigs) {
4424854ce69bSBarry Smith         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
4425854ce69bSBarry Smith         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
44266e683305SStefano Zampini         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
44276e683305SStefano Zampini         lambda_max = eigs_r[neigs-1];
44286e683305SStefano Zampini         lambda_min = eigs_r[0];
44296e683305SStefano Zampini         if (pcbddc->use_coarse_estimates) {
44306e683305SStefano Zampini           if (lambda_max>lambda_min) {
4431cbcc2c2aSStefano Zampini             ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max,lambda_min);CHKERRQ(ierr);
4432cbcc2c2aSStefano Zampini             ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
4433cbcc2c2aSStefano Zampini           }
4434c8587f34SStefano Zampini         }
4435c8587f34SStefano Zampini       }
4436cbcc2c2aSStefano Zampini 
4437c8587f34SStefano Zampini       /* check coarse problem residual error */
44386e683305SStefano Zampini       if (pcbddc->dbg_flag) {
44396e683305SStefano Zampini         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
44406e683305SStefano Zampini         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
44416e683305SStefano Zampini         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
4442c8587f34SStefano Zampini         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
44436e683305SStefano Zampini         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
44446e683305SStefano Zampini         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
4445c8587f34SStefano Zampini         ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
4446779c1cceSStefano Zampini         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
44476e683305SStefano Zampini         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
44486e683305SStefano Zampini         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
44496e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
44506e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
44516e683305SStefano Zampini         if (compute_eigs) {
44526e683305SStefano Zampini           PetscReal lambda_max_s,lambda_min_s;
4453deec49d1SStefano Zampini           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
4454c8587f34SStefano Zampini           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
44556e683305SStefano Zampini           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
44566e683305SStefano 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);
44576e683305SStefano Zampini           for (i=0;i<neigs;i++) {
44586e683305SStefano Zampini             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
4459c8587f34SStefano Zampini           }
44606e683305SStefano Zampini         }
44616e683305SStefano Zampini         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
44626e683305SStefano Zampini         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
44636e683305SStefano Zampini       }
4464c8587f34SStefano Zampini       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
44656e683305SStefano Zampini       if (compute_eigs) {
44666e683305SStefano Zampini         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
44676e683305SStefano Zampini         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
4468c8587f34SStefano Zampini       }
44696e683305SStefano Zampini     }
44706e683305SStefano Zampini   }
4471cbcc2c2aSStefano Zampini   /* print additional info */
4472cbcc2c2aSStefano Zampini   if (pcbddc->dbg_flag) {
44736e683305SStefano Zampini     /* waits until all processes reaches this point */
44746e683305SStefano Zampini     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
4475cbcc2c2aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
4476cbcc2c2aSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4477cbcc2c2aSStefano Zampini   }
4478cbcc2c2aSStefano Zampini 
44792b510759SStefano Zampini   /* free memory */
4480c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
4481fdc635d7SStefano Zampini   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
4482c8587f34SStefano Zampini   PetscFunctionReturn(0);
4483c8587f34SStefano Zampini }
4484674ae819SStefano Zampini 
4485f34684f1SStefano Zampini #undef __FUNCT__
4486f34684f1SStefano Zampini #define __FUNCT__ "PCBDDCComputePrimalNumbering"
4487f34684f1SStefano Zampini PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
4488f34684f1SStefano Zampini {
4489f34684f1SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4490f34684f1SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
4491f34684f1SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
449273be2a3aSStefano Zampini   PetscInt       i,coarse_size=0;
449373be2a3aSStefano Zampini   PetscInt       *local_primal_indices=NULL;
4494f34684f1SStefano Zampini   PetscErrorCode ierr;
4495f34684f1SStefano Zampini 
4496f34684f1SStefano Zampini   PetscFunctionBegin;
4497f34684f1SStefano Zampini   /* Compute global number of coarse dofs */
449889c96988SStefano Zampini   if (!pcbddc->primal_indices_local_idxs && pcbddc->local_primal_size) {
449989c96988SStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Local primal indices have not been created");
4500727cdba6SStefano Zampini   }
4501727cdba6SStefano 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);
4502f34684f1SStefano Zampini 
4503f34684f1SStefano Zampini   /* check numbering */
4504f34684f1SStefano Zampini   if (pcbddc->dbg_flag) {
4505f34684f1SStefano Zampini     PetscScalar coarsesum,*array;
4506b9b85e73SStefano Zampini     PetscBool set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
4507f34684f1SStefano Zampini 
4508f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4509f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4510f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
45110fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
4512f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
4513f34684f1SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
4514727cdba6SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
4515f34684f1SStefano Zampini     }
4516f34684f1SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
4517f34684f1SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
4518f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
4519f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4520f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4521f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4522f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4523f34684f1SStefano Zampini     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4524f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
4525f34684f1SStefano Zampini       if (array[i] == 1.0) {
4526b9b85e73SStefano Zampini         set_error = PETSC_TRUE;
4527f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d owned by a single process!\n",PetscGlobalRank,i);CHKERRQ(ierr);
4528f34684f1SStefano Zampini       }
4529f34684f1SStefano Zampini     }
4530b9b85e73SStefano Zampini     ierr = MPI_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4531f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4532f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
4533f34684f1SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
4534f34684f1SStefano Zampini     }
4535f34684f1SStefano Zampini     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4536f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
4537f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4538f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4539f34684f1SStefano Zampini     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
4540f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
4541b9b85e73SStefano Zampini     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
4542ca8b9ea9SStefano Zampini       PetscInt *gidxs;
4543ca8b9ea9SStefano Zampini 
4544ca8b9ea9SStefano Zampini       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
4545ca8b9ea9SStefano Zampini       ierr = ISLocalToGlobalMappingApply(matis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
4546f34684f1SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
4547f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4548f34684f1SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
4549f34684f1SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
4550ca8b9ea9SStefano 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]);
4551f34684f1SStefano Zampini       }
4552f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4553ca8b9ea9SStefano Zampini       ierr = PetscFree(gidxs);CHKERRQ(ierr);
4554f34684f1SStefano Zampini     }
4555f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4556b9b85e73SStefano Zampini     if (set_error_reduced) {
4557b9b85e73SStefano Zampini       SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
4558b9b85e73SStefano Zampini     }
4559f34684f1SStefano Zampini   }
45608bec7fa6SStefano Zampini   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
4561f34684f1SStefano Zampini   /* get back data */
4562f34684f1SStefano Zampini   *coarse_size_n = coarse_size;
4563f34684f1SStefano Zampini   *local_primal_indices_n = local_primal_indices;
4564674ae819SStefano Zampini   PetscFunctionReturn(0);
4565674ae819SStefano Zampini }
4566674ae819SStefano Zampini 
4567e456f2a8SStefano Zampini #undef __FUNCT__
4568e456f2a8SStefano Zampini #define __FUNCT__ "PCBDDCGlobalToLocal"
4569a7dc3881SStefano Zampini PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
4570e456f2a8SStefano Zampini {
4571e456f2a8SStefano Zampini   IS             localis_t;
4572a7dc3881SStefano Zampini   PetscInt       i,lsize,*idxs,n;
4573e456f2a8SStefano Zampini   PetscScalar    *vals;
4574e456f2a8SStefano Zampini   PetscErrorCode ierr;
4575e456f2a8SStefano Zampini 
4576e456f2a8SStefano Zampini   PetscFunctionBegin;
4577a7dc3881SStefano Zampini   /* get indices in local ordering exploiting local to global map */
4578e456f2a8SStefano Zampini   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
4579854ce69bSBarry Smith   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
4580e456f2a8SStefano Zampini   for (i=0;i<lsize;i++) vals[i] = 1.0;
4581e456f2a8SStefano Zampini   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
4582a7dc3881SStefano Zampini   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
4583a7dc3881SStefano Zampini   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
45841035eff8SStefano Zampini   if (idxs) { /* multilevel guard */
4585a7dc3881SStefano Zampini     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
45861035eff8SStefano Zampini   }
4587a7dc3881SStefano Zampini   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
4588e456f2a8SStefano Zampini   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
4589e456f2a8SStefano Zampini   ierr = PetscFree(vals);CHKERRQ(ierr);
4590a7dc3881SStefano Zampini   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
4591a7dc3881SStefano Zampini   /* now compute set in local ordering */
4592a7dc3881SStefano Zampini   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4593a7dc3881SStefano Zampini   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4594a7dc3881SStefano Zampini   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
4595a7dc3881SStefano Zampini   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
4596a7dc3881SStefano Zampini   for (i=0,lsize=0;i<n;i++) {
4597ff92baa0SMatthew G. Knepley     if (PetscRealPart(vals[i]) > 0.5) {
4598e456f2a8SStefano Zampini       lsize++;
4599e456f2a8SStefano Zampini     }
4600e456f2a8SStefano Zampini   }
4601854ce69bSBarry Smith   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
4602a7dc3881SStefano Zampini   for (i=0,lsize=0;i<n;i++) {
4603ff92baa0SMatthew G. Knepley     if (PetscRealPart(vals[i]) > 0.5) {
4604e456f2a8SStefano Zampini       idxs[lsize++] = i;
4605e456f2a8SStefano Zampini     }
4606e456f2a8SStefano Zampini   }
4607a7dc3881SStefano Zampini   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
4608a7dc3881SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
4609e456f2a8SStefano Zampini   *localis = localis_t;
4610e456f2a8SStefano Zampini   PetscFunctionReturn(0);
4611e456f2a8SStefano Zampini }
4612906d46d4SStefano Zampini 
4613906d46d4SStefano Zampini /* the next two functions will be called in KSPMatMult if a change of basis has been requested */
4614906d46d4SStefano Zampini #undef __FUNCT__
4615906d46d4SStefano Zampini #define __FUNCT__ "PCBDDCMatMult_Private"
4616906d46d4SStefano Zampini static PetscErrorCode PCBDDCMatMult_Private(Mat A, Vec x, Vec y)
4617906d46d4SStefano Zampini {
4618906d46d4SStefano Zampini   PCBDDCChange_ctx change_ctx;
4619906d46d4SStefano Zampini   PetscErrorCode   ierr;
4620906d46d4SStefano Zampini 
4621906d46d4SStefano Zampini   PetscFunctionBegin;
4622906d46d4SStefano Zampini   ierr = MatShellGetContext(A,&change_ctx);CHKERRQ(ierr);
4623906d46d4SStefano Zampini   ierr = MatMult(change_ctx->global_change,x,change_ctx->work[0]);CHKERRQ(ierr);
4624906d46d4SStefano Zampini   ierr = MatMult(change_ctx->original_mat,change_ctx->work[0],change_ctx->work[1]);CHKERRQ(ierr);
4625906d46d4SStefano Zampini   ierr = MatMultTranspose(change_ctx->global_change,change_ctx->work[1],y);CHKERRQ(ierr);
4626906d46d4SStefano Zampini   PetscFunctionReturn(0);
4627906d46d4SStefano Zampini }
4628906d46d4SStefano Zampini 
4629906d46d4SStefano Zampini #undef __FUNCT__
4630906d46d4SStefano Zampini #define __FUNCT__ "PCBDDCMatMultTranspose_Private"
4631906d46d4SStefano Zampini static PetscErrorCode PCBDDCMatMultTranspose_Private(Mat A, Vec x, Vec y)
4632906d46d4SStefano Zampini {
4633906d46d4SStefano Zampini   PCBDDCChange_ctx change_ctx;
4634906d46d4SStefano Zampini   PetscErrorCode   ierr;
4635906d46d4SStefano Zampini 
4636906d46d4SStefano Zampini   PetscFunctionBegin;
4637906d46d4SStefano Zampini   ierr = MatShellGetContext(A,&change_ctx);CHKERRQ(ierr);
4638906d46d4SStefano Zampini   ierr = MatMult(change_ctx->global_change,x,change_ctx->work[0]);CHKERRQ(ierr);
4639906d46d4SStefano Zampini   ierr = MatMultTranspose(change_ctx->original_mat,change_ctx->work[0],change_ctx->work[1]);CHKERRQ(ierr);
4640906d46d4SStefano Zampini   ierr = MatMultTranspose(change_ctx->global_change,change_ctx->work[1],y);CHKERRQ(ierr);
4641906d46d4SStefano Zampini   PetscFunctionReturn(0);
4642906d46d4SStefano Zampini }
4643b96c3477SStefano Zampini 
4644b96c3477SStefano Zampini #undef __FUNCT__
4645b96c3477SStefano Zampini #define __FUNCT__ "PCBDDCSetUpSubSchurs"
464608122e43SStefano Zampini PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
4647b96c3477SStefano Zampini {
4648b96c3477SStefano Zampini   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
4649b96c3477SStefano Zampini   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
4650b96c3477SStefano Zampini   PetscInt            *used_xadj,*used_adjncy;
4651b96c3477SStefano Zampini   PetscBool           free_used_adj;
4652b96c3477SStefano Zampini   PetscErrorCode      ierr;
4653b96c3477SStefano Zampini 
4654b96c3477SStefano Zampini   PetscFunctionBegin;
4655b96c3477SStefano Zampini   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
4656b96c3477SStefano Zampini   free_used_adj = PETSC_FALSE;
465708122e43SStefano Zampini   if (pcbddc->sub_schurs_layers == -1) {
4658b96c3477SStefano Zampini     used_xadj = NULL;
4659b96c3477SStefano Zampini     used_adjncy = NULL;
4660b96c3477SStefano Zampini   } else {
466108122e43SStefano Zampini     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
466208122e43SStefano Zampini       used_xadj = pcbddc->mat_graph->xadj;
466308122e43SStefano Zampini       used_adjncy = pcbddc->mat_graph->adjncy;
466408122e43SStefano Zampini     } else if (pcbddc->computed_rowadj) {
4665b96c3477SStefano Zampini       used_xadj = pcbddc->mat_graph->xadj;
4666b96c3477SStefano Zampini       used_adjncy = pcbddc->mat_graph->adjncy;
4667b96c3477SStefano Zampini     } else {
46682fffb893SStefano Zampini       PetscBool      flg_row=PETSC_FALSE;
4669b96c3477SStefano Zampini       const PetscInt *xadj,*adjncy;
4670b96c3477SStefano Zampini       PetscInt       nvtxs;
4671b96c3477SStefano Zampini 
46722fffb893SStefano Zampini       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
46732fffb893SStefano Zampini       if (flg_row) {
4674b96c3477SStefano Zampini         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
4675b96c3477SStefano Zampini         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
4676b96c3477SStefano Zampini         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
4677b96c3477SStefano Zampini         free_used_adj = PETSC_TRUE;
46782fffb893SStefano Zampini       } else {
46792fffb893SStefano Zampini         pcbddc->sub_schurs_layers = -1;
46802fffb893SStefano Zampini         used_xadj = NULL;
46812fffb893SStefano Zampini         used_adjncy = NULL;
46822fffb893SStefano Zampini       }
46832fffb893SStefano Zampini       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4684b96c3477SStefano Zampini     }
4685b96c3477SStefano Zampini   }
4686*5a95e1ceSStefano Zampini   ierr = PCBDDCSubSchursSetUp(sub_schurs,used_xadj,used_adjncy,pcbddc->sub_schurs_layers,pcbddc->adaptive_selection,pcbddc->adaptive_invert_Stildas,pcbddc->use_edges,pcbddc->use_faces);CHKERRQ(ierr);
4687b96c3477SStefano Zampini 
4688b96c3477SStefano Zampini   /* free adjacency */
4689b96c3477SStefano Zampini   if (free_used_adj) {
4690b96c3477SStefano Zampini     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
4691b96c3477SStefano Zampini   }
4692b96c3477SStefano Zampini   PetscFunctionReturn(0);
4693b96c3477SStefano Zampini }
4694b96c3477SStefano Zampini 
4695b96c3477SStefano Zampini #undef __FUNCT__
4696b96c3477SStefano Zampini #define __FUNCT__ "PCBDDCInitSubSchurs"
469708122e43SStefano Zampini PetscErrorCode PCBDDCInitSubSchurs(PC pc)
4698b96c3477SStefano Zampini {
4699b96c3477SStefano Zampini   PC_IS               *pcis=(PC_IS*)pc->data;
4700b96c3477SStefano Zampini   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
4701b96c3477SStefano Zampini   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
4702b96c3477SStefano Zampini   PCBDDCGraph         graph;
4703b96c3477SStefano Zampini   Mat                 S_j;
4704b96c3477SStefano Zampini   PetscErrorCode      ierr;
4705b96c3477SStefano Zampini 
4706b96c3477SStefano Zampini   PetscFunctionBegin;
4707b96c3477SStefano Zampini   /* attach interface graph for determining subsets */
470808122e43SStefano Zampini   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
4709b96c3477SStefano Zampini     IS verticesIS;
4710b96c3477SStefano Zampini 
4711b96c3477SStefano Zampini     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
4712b96c3477SStefano Zampini     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
4713b96c3477SStefano Zampini     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap);CHKERRQ(ierr);
4714b96c3477SStefano Zampini     ierr = PCBDDCGraphSetUp(graph,0,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticesIS);CHKERRQ(ierr);
4715b96c3477SStefano Zampini     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
4716b96c3477SStefano Zampini     ierr = ISDestroy(&verticesIS);CHKERRQ(ierr);
4717b96c3477SStefano Zampini /*
4718b96c3477SStefano Zampini     if (pcbddc->dbg_flag) {
4719b96c3477SStefano Zampini       ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
4720b96c3477SStefano Zampini     }
4721b96c3477SStefano Zampini */
4722b96c3477SStefano Zampini   } else {
4723b96c3477SStefano Zampini     graph = pcbddc->mat_graph;
4724b96c3477SStefano Zampini   }
4725b96c3477SStefano Zampini 
4726b96c3477SStefano Zampini   /* Create Schur complement matrix */
4727b96c3477SStefano Zampini   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
4728b96c3477SStefano Zampini   ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
4729b96c3477SStefano Zampini 
4730b96c3477SStefano Zampini   /* sub_schurs init */
4731*5a95e1ceSStefano Zampini   ierr = PCBDDCSubSchursInit(sub_schurs,pcbddc->local_mat,S_j,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap);CHKERRQ(ierr);
4732b96c3477SStefano Zampini   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
4733b96c3477SStefano Zampini   /* free graph struct */
473408122e43SStefano Zampini   if (pcbddc->sub_schurs_rebuild) {
4735b96c3477SStefano Zampini     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
4736b96c3477SStefano Zampini   }
4737b96c3477SStefano Zampini   PetscFunctionReturn(0);
4738b96c3477SStefano Zampini }
4739