xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 4bc2dc4bd263f882f69e906548202714ae1fb6b6)
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)) {
2343ac632422SStefano Zampini       if (!pcbddc->use_qr_single && !pcbddc->faster_deluxe) {
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) {
2756ac632422SStefano Zampini         Mat S_new,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);
2762ac632422SStefano Zampini         ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
2763b96c3477SStefano Zampini         ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
2764ac632422SStefano Zampini         ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
2765ac632422SStefano Zampini         sub_schurs->S_Ej_all = S_new;
2766ac632422SStefano Zampini         ierr = MatDestroy(&S_new);CHKERRQ(ierr);
2767ac632422SStefano Zampini         if (sub_schurs->sum_S_Ej_all) {
2768ac632422SStefano Zampini           ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
2769b96c3477SStefano Zampini           ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
2770ac632422SStefano Zampini           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
2771ac632422SStefano Zampini           sub_schurs->sum_S_Ej_all = S_new;
2772ac632422SStefano Zampini           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
2773ac632422SStefano Zampini         }
2774b96c3477SStefano Zampini         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
2775b96c3477SStefano Zampini       }
2776b96c3477SStefano Zampini     }
2777906d46d4SStefano Zampini     ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
2778906d46d4SStefano Zampini   } else if (pcbddc->user_ChangeOfBasisMatrix) {
2779b9b85e73SStefano Zampini     ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
2780b9b85e73SStefano Zampini     pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
2781b9b85e73SStefano Zampini   }
2782906d46d4SStefano Zampini 
2783906d46d4SStefano Zampini   /* set up change of basis context */
2784906d46d4SStefano Zampini   if (pcbddc->ChangeOfBasisMatrix) {
2785906d46d4SStefano Zampini     PCBDDCChange_ctx change_ctx;
2786906d46d4SStefano Zampini 
2787906d46d4SStefano Zampini     if (!pcbddc->new_global_mat) {
2788906d46d4SStefano Zampini       PetscInt global_size,local_size;
2789906d46d4SStefano Zampini 
2790906d46d4SStefano Zampini       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
2791906d46d4SStefano Zampini       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
2792906d46d4SStefano Zampini       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->new_global_mat);CHKERRQ(ierr);
2793906d46d4SStefano Zampini       ierr = MatSetSizes(pcbddc->new_global_mat,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
2794906d46d4SStefano Zampini       ierr = MatSetType(pcbddc->new_global_mat,MATSHELL);CHKERRQ(ierr);
2795906d46d4SStefano Zampini       ierr = MatShellSetOperation(pcbddc->new_global_mat,MATOP_MULT,(void (*)(void))PCBDDCMatMult_Private);CHKERRQ(ierr);
2796906d46d4SStefano Zampini       ierr = MatShellSetOperation(pcbddc->new_global_mat,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCMatMultTranspose_Private);CHKERRQ(ierr);
2797906d46d4SStefano Zampini       ierr = PetscNew(&change_ctx);CHKERRQ(ierr);
2798906d46d4SStefano Zampini       ierr = MatShellSetContext(pcbddc->new_global_mat,change_ctx);CHKERRQ(ierr);
2799906d46d4SStefano Zampini     } else {
2800906d46d4SStefano Zampini       ierr = MatShellGetContext(pcbddc->new_global_mat,&change_ctx);CHKERRQ(ierr);
2801906d46d4SStefano Zampini       ierr = MatDestroy(&change_ctx->global_change);CHKERRQ(ierr);
2802906d46d4SStefano Zampini       ierr = VecDestroyVecs(2,&change_ctx->work);CHKERRQ(ierr);
2803906d46d4SStefano Zampini     }
2804906d46d4SStefano Zampini     if (!pcbddc->user_ChangeOfBasisMatrix) {
2805906d46d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
2806906d46d4SStefano Zampini       change_ctx->global_change = pcbddc->ChangeOfBasisMatrix;
2807906d46d4SStefano Zampini     } else {
2808906d46d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
2809906d46d4SStefano Zampini       change_ctx->global_change = pcbddc->user_ChangeOfBasisMatrix;
2810906d46d4SStefano Zampini     }
2811906d46d4SStefano Zampini     ierr = VecDuplicateVecs(pcis->vec1_global,2,&change_ctx->work);CHKERRQ(ierr);
2812906d46d4SStefano Zampini     ierr = MatSetUp(pcbddc->new_global_mat);CHKERRQ(ierr);
2813906d46d4SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->new_global_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2814906d46d4SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->new_global_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2815b9b85e73SStefano Zampini   }
2816a717540cSStefano Zampini 
2817727cdba6SStefano Zampini   /* get indices in local ordering for vertices and constraints */
2818727cdba6SStefano 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 */
2819473ba861SJed Brown     ierr = PetscMalloc1(olocal_primal_size,&oprimal_indices_local_idxs);CHKERRQ(ierr);
2820727cdba6SStefano Zampini     ierr = PetscMemcpy(oprimal_indices_local_idxs,pcbddc->primal_indices_local_idxs,olocal_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
2821727cdba6SStefano Zampini   }
2822727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2823f347579bSStefano Zampini   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
2824473ba861SJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
2825727cdba6SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_primal_numbering);CHKERRQ(ierr);
2826727cdba6SStefano Zampini   ierr = PetscMemcpy(pcbddc->primal_indices_local_idxs,aux_primal_numbering,i*sizeof(PetscInt));CHKERRQ(ierr);
2827727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2828727cdba6SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_primal_numbering);CHKERRQ(ierr);
2829727cdba6SStefano Zampini   ierr = PetscMemcpy(&pcbddc->primal_indices_local_idxs[i],aux_primal_numbering,j*sizeof(PetscInt));CHKERRQ(ierr);
2830727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2831e9189074SStefano Zampini   /* set quantities in PCBDDC data struct */
2832e9189074SStefano Zampini   pcbddc->n_actual_vertices = i;
2833727cdba6SStefano Zampini   /* check if a new primal space has been introduced */
2834727cdba6SStefano Zampini   pcbddc->new_primal_space_local = PETSC_TRUE;
2835727cdba6SStefano Zampini   if (olocal_primal_size == pcbddc->local_primal_size) {
2836727cdba6SStefano Zampini     ierr = PetscMemcmp(pcbddc->primal_indices_local_idxs,oprimal_indices_local_idxs,olocal_primal_size,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
2837c1c8e736SStefano Zampini     pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
2838727cdba6SStefano Zampini     ierr = PetscFree(oprimal_indices_local_idxs);CHKERRQ(ierr);
2839727cdba6SStefano Zampini   }
2840727cdba6SStefano Zampini   /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
2841727cdba6SStefano Zampini   ierr = MPI_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2842727cdba6SStefano Zampini 
2843a717540cSStefano Zampini   /* flush dbg viewer */
2844b8ffe317SStefano Zampini   if (pcbddc->dbg_flag) {
2845b8ffe317SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2846b8ffe317SStefano Zampini   }
2847a717540cSStefano Zampini 
2848e310c8b4SStefano Zampini   /* free workspace */
2849a717540cSStefano Zampini   ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2850a717540cSStefano Zampini   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
2851984c4197SStefano Zampini   ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr);
28524641a718SStefano Zampini   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
285308122e43SStefano Zampini   if (!pcbddc->adaptive_selection) {
2854906d46d4SStefano Zampini     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
2855906d46d4SStefano Zampini     ierr = PetscFree3(temp_quadrature_constraint,temp_indices_to_constraint,temp_indices_to_constraint_B);CHKERRQ(ierr);
285608122e43SStefano Zampini   } else {
285708122e43SStefano Zampini     ierr = PetscFree4(pcbddc->adaptive_constraints_n,
285808122e43SStefano Zampini                       pcbddc->adaptive_constraints_ptrs,
285908122e43SStefano Zampini                       pcbddc->adaptive_constraints_idxs,
286008122e43SStefano Zampini                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
286108122e43SStefano Zampini     ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
286208122e43SStefano Zampini   }
2863674ae819SStefano Zampini   PetscFunctionReturn(0);
2864674ae819SStefano Zampini }
2865674ae819SStefano Zampini 
2866674ae819SStefano Zampini #undef __FUNCT__
2867674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
2868674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
2869674ae819SStefano Zampini {
2870674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
2871674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
2872674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
287363602bcaSStefano Zampini   PetscInt    ierr,i,vertex_size;
2874674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
2875674ae819SStefano Zampini 
2876674ae819SStefano Zampini   PetscFunctionBegin;
28778e61c736SStefano Zampini   /* Reset previously computed graph */
28788e61c736SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
2879674ae819SStefano Zampini   /* Init local Graph struct */
2880674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
2881674ae819SStefano Zampini 
2882575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
2883575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
2884575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
2885575ad6abSStefano Zampini   }
28869577ea80SStefano Zampini 
2887674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
28884d379d7bSStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
28894d379d7bSStefano Zampini     PetscInt  *xadj,*adjncy;
28904d379d7bSStefano Zampini     PetscInt  nvtxs;
2891e496cd5dSStefano Zampini     PetscBool flg_row=PETSC_FALSE;
2892674ae819SStefano Zampini 
28934d379d7bSStefano Zampini     if (pcbddc->use_local_adj) {
28942fffb893SStefano Zampini 
28952fffb893SStefano Zampini       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
28962fffb893SStefano Zampini       if (flg_row) {
28974d379d7bSStefano Zampini         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
2898b96c3477SStefano Zampini         pcbddc->computed_rowadj = PETSC_TRUE;
28992fffb893SStefano Zampini       }
29002fffb893SStefano Zampini       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
29012fffb893SStefano Zampini     } else if (pcbddc->current_level) { /* just compute subdomain's connected components for coarser levels */
29024d379d7bSStefano Zampini       IS                     is_dummy;
29034d379d7bSStefano Zampini       ISLocalToGlobalMapping l2gmap_dummy;
29044d379d7bSStefano Zampini       PetscInt               j,sum;
29054d379d7bSStefano Zampini       PetscInt               *cxadj,*cadjncy;
29064d379d7bSStefano Zampini       const PetscInt         *idxs;
29074d379d7bSStefano Zampini       PCBDDCGraph            graph;
29084d379d7bSStefano Zampini       PetscBT                is_on_boundary;
29094d379d7bSStefano Zampini 
29104d379d7bSStefano Zampini       ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n,0,1,&is_dummy);CHKERRQ(ierr);
29114d379d7bSStefano Zampini       ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
29124d379d7bSStefano Zampini       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
29134d379d7bSStefano Zampini       ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
29144d379d7bSStefano Zampini       ierr = PCBDDCGraphInit(graph,l2gmap_dummy);CHKERRQ(ierr);
29154d379d7bSStefano Zampini       ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2916e496cd5dSStefano Zampini       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2917e496cd5dSStefano Zampini       if (flg_row) {
29184d379d7bSStefano Zampini         graph->xadj = xadj;
29194d379d7bSStefano Zampini         graph->adjncy = adjncy;
2920e496cd5dSStefano Zampini       }
29214d379d7bSStefano Zampini       ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
29224d379d7bSStefano Zampini       ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2923e496cd5dSStefano Zampini       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
29244d379d7bSStefano Zampini 
29254d379d7bSStefano Zampini       if (pcbddc->dbg_flag) {
29264d379d7bSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"[%d] Found %d subdomains\n",PetscGlobalRank,graph->ncc);CHKERRQ(ierr);
29274d379d7bSStefano Zampini         for (i=0;i<graph->ncc;i++) {
29284d379d7bSStefano Zampini           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"[%d] %d cc size %d\n",PetscGlobalRank,i,graph->cptr[i+1]-graph->cptr[i]);CHKERRQ(ierr);
29294d379d7bSStefano Zampini         }
29304d379d7bSStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
29314d379d7bSStefano Zampini       }
29324d379d7bSStefano Zampini 
2933e496cd5dSStefano Zampini       ierr = PetscBTCreate(pcis->n,&is_on_boundary);CHKERRQ(ierr);
29344d379d7bSStefano Zampini       ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
29354d379d7bSStefano Zampini       for (i=0;i<pcis->n_B;i++) {
29364d379d7bSStefano Zampini         ierr = PetscBTSet(is_on_boundary,idxs[i]);CHKERRQ(ierr);
29374d379d7bSStefano Zampini       }
29384d379d7bSStefano Zampini       ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
29394d379d7bSStefano Zampini 
2940e496cd5dSStefano Zampini       ierr = PetscCalloc1(pcis->n+1,&cxadj);CHKERRQ(ierr);
29414d379d7bSStefano Zampini       sum = 0;
29424d379d7bSStefano Zampini       for (i=0;i<graph->ncc;i++) {
29434d379d7bSStefano Zampini         PetscInt sizecc = 0;
29444d379d7bSStefano Zampini         for (j=graph->cptr[i];j<graph->cptr[i+1];j++) {
29454d379d7bSStefano Zampini           if (PetscBTLookup(is_on_boundary,graph->queue[j])) {
29464d379d7bSStefano Zampini             sizecc++;
29474d379d7bSStefano Zampini           }
29484d379d7bSStefano Zampini         }
29494d379d7bSStefano Zampini         for (j=graph->cptr[i];j<graph->cptr[i+1];j++) {
29504d379d7bSStefano Zampini           if (PetscBTLookup(is_on_boundary,graph->queue[j])) {
29514d379d7bSStefano Zampini             cxadj[graph->queue[j]] = sizecc;
29524d379d7bSStefano Zampini           }
29534d379d7bSStefano Zampini         }
29544d379d7bSStefano Zampini         sum += sizecc*sizecc;
29554d379d7bSStefano Zampini       }
29564d379d7bSStefano Zampini       ierr = PetscMalloc1(sum,&cadjncy);CHKERRQ(ierr);
29574d379d7bSStefano Zampini       sum = 0;
2958e496cd5dSStefano Zampini       for (i=0;i<pcis->n;i++) {
29594d379d7bSStefano Zampini         PetscInt temp = cxadj[i];
29604d379d7bSStefano Zampini         cxadj[i] = sum;
29614d379d7bSStefano Zampini         sum += temp;
29624d379d7bSStefano Zampini       }
2963e496cd5dSStefano Zampini       cxadj[pcis->n] = sum;
29644d379d7bSStefano Zampini       for (i=0;i<graph->ncc;i++) {
29654d379d7bSStefano Zampini         for (j=graph->cptr[i];j<graph->cptr[i+1];j++) {
29664d379d7bSStefano Zampini           if (PetscBTLookup(is_on_boundary,graph->queue[j])) {
29674d379d7bSStefano Zampini             PetscInt k,sizecc = 0;
29684d379d7bSStefano Zampini             for (k=graph->cptr[i];k<graph->cptr[i+1];k++) {
29694d379d7bSStefano Zampini               if (PetscBTLookup(is_on_boundary,graph->queue[k])) {
29704d379d7bSStefano Zampini                 cadjncy[cxadj[graph->queue[j]]+sizecc]=graph->queue[k];
29714d379d7bSStefano Zampini                 sizecc++;
29724d379d7bSStefano Zampini               }
29734d379d7bSStefano Zampini             }
29744d379d7bSStefano Zampini           }
29754d379d7bSStefano Zampini         }
29764d379d7bSStefano Zampini       }
2977e496cd5dSStefano Zampini       if (pcis->n) {
2978e496cd5dSStefano Zampini         ierr = PCBDDCSetLocalAdjacencyGraph(pc,pcis->n,cxadj,cadjncy,PETSC_OWN_POINTER);CHKERRQ(ierr);
29794d379d7bSStefano Zampini       } else {
29804d379d7bSStefano Zampini         ierr = PetscFree(cxadj);CHKERRQ(ierr);
29814d379d7bSStefano Zampini         ierr = PetscFree(cadjncy);CHKERRQ(ierr);
29824d379d7bSStefano Zampini       }
29834d379d7bSStefano Zampini       graph->xadj = 0;
29844d379d7bSStefano Zampini       graph->adjncy = 0;
29854d379d7bSStefano Zampini       ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
29864d379d7bSStefano Zampini       ierr = PetscBTDestroy(&is_on_boundary);CHKERRQ(ierr);
29874d379d7bSStefano Zampini     }
2988674ae819SStefano Zampini   }
2989674ae819SStefano Zampini 
299063602bcaSStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting or PCBDDCSetDofsSplittingLocal */
2991674ae819SStefano Zampini   vertex_size = 1;
299263602bcaSStefano Zampini   if (pcbddc->user_provided_isfordofs) {
299363602bcaSStefano Zampini     if (pcbddc->n_ISForDofs) { /* need to convert from global to local and remove references to global dofs splitting */
299495ecbf38SStefano Zampini       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
299563602bcaSStefano Zampini       for (i=0;i<pcbddc->n_ISForDofs;i++) {
2996a7dc3881SStefano Zampini         ierr = PCBDDCGlobalToLocal(matis->ctx,pcis->vec1_global,pcis->vec1_N,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
299763602bcaSStefano Zampini         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
2998674ae819SStefano Zampini       }
299963602bcaSStefano Zampini       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
300063602bcaSStefano Zampini       pcbddc->n_ISForDofs = 0;
300163602bcaSStefano Zampini       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
3002674ae819SStefano Zampini     }
300363602bcaSStefano Zampini     /* mat block size as vertex size (used for elasticity with rigid body modes as nearnullspace) */
3004674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
300563602bcaSStefano Zampini   } else {
300663602bcaSStefano Zampini     if (!pcbddc->n_ISForDofsLocal) { /* field split not present, create it in local ordering */
300763602bcaSStefano Zampini       ierr = MatGetBlockSize(pc->pmat,&pcbddc->n_ISForDofsLocal);CHKERRQ(ierr);
3008854ce69bSBarry Smith       ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
300963602bcaSStefano Zampini       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
301063602bcaSStefano Zampini         ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),pcis->n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
301163602bcaSStefano Zampini       }
301263602bcaSStefano Zampini     }
3013674ae819SStefano Zampini   }
3014674ae819SStefano Zampini 
3015674ae819SStefano Zampini   /* Setup of Graph */
3016785d1243SStefano Zampini   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) { /* need to convert from global to local */
3017a7dc3881SStefano Zampini     ierr = PCBDDCGlobalToLocal(matis->ctx,pcis->vec1_global,pcis->vec1_N,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3018785d1243SStefano Zampini   }
3019785d1243SStefano Zampini   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) { /* need to convert from global to local */
3020a7dc3881SStefano Zampini     ierr = PCBDDCGlobalToLocal(matis->ctx,pcis->vec1_global,pcis->vec1_N,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3021785d1243SStefano Zampini   }
3022302440fdSBarry Smith   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices);CHKERRQ(ierr);
3023674ae819SStefano Zampini 
3024674ae819SStefano Zampini   /* Graph's connected components analysis */
3025674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
3026674ae819SStefano Zampini 
3027674ae819SStefano Zampini   /* print some info to stdout */
3028674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
3029302440fdSBarry Smith     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);CHKERRQ(ierr);
3030674ae819SStefano Zampini   }
3031fb180af4SStefano Zampini 
3032fb180af4SStefano Zampini   /* mark topography has done */
3033fb180af4SStefano Zampini   pcbddc->recompute_topography = PETSC_FALSE;
3034674ae819SStefano Zampini   PetscFunctionReturn(0);
3035674ae819SStefano Zampini }
3036674ae819SStefano Zampini 
3037674ae819SStefano Zampini #undef __FUNCT__
3038674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
3039f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt **vertices_idx)
3040674ae819SStefano Zampini {
3041674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
3042674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
3043674ae819SStefano Zampini   PetscErrorCode ierr;
3044674ae819SStefano Zampini 
3045674ae819SStefano Zampini   PetscFunctionBegin;
3046674ae819SStefano Zampini   n = 0;
3047674ae819SStefano Zampini   vertices = 0;
3048674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
3049674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
3050b120a5c6SStefano Zampini     for (i=0;i<local_primal_size;i++) {
3051b120a5c6SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
3052b120a5c6SStefano Zampini       if (size_of_constraint == 1) n++;
3053b120a5c6SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
3054b120a5c6SStefano Zampini     }
3055811e8ca2SStefano Zampini     if (vertices_idx) {
3056785e854fSJed Brown       ierr = PetscMalloc1(n,&vertices);CHKERRQ(ierr);
3057b120a5c6SStefano Zampini       n = 0;
3058674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
3059674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
3060674ae819SStefano Zampini         if (size_of_constraint == 1) {
3061674ae819SStefano Zampini           vertices[n++]=row_cmat_indices[0];
3062674ae819SStefano Zampini         }
3063674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
3064674ae819SStefano Zampini       }
3065674ae819SStefano Zampini     }
3066811e8ca2SStefano Zampini   }
3067674ae819SStefano Zampini   *n_vertices = n;
3068811e8ca2SStefano Zampini   if (vertices_idx) *vertices_idx = vertices;
3069674ae819SStefano Zampini   PetscFunctionReturn(0);
3070674ae819SStefano Zampini }
3071674ae819SStefano Zampini 
3072674ae819SStefano Zampini #undef __FUNCT__
3073674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
3074f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt **constraints_idx)
3075674ae819SStefano Zampini {
3076674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
3077674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
3078674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
30794641a718SStefano Zampini   PetscBT        touched;
3080674ae819SStefano Zampini   PetscErrorCode ierr;
3081674ae819SStefano Zampini 
3082f34684f1SStefano Zampini     /* This function assumes that the number of local constraints per connected component
3083f34684f1SStefano Zampini        is not greater than the number of nodes defined for the connected component
3084f34684f1SStefano Zampini        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
3085674ae819SStefano Zampini   PetscFunctionBegin;
3086674ae819SStefano Zampini   n = 0;
3087674ae819SStefano Zampini   constraints_index = 0;
3088674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
3089674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
3090674ae819SStefano Zampini     max_size_of_constraint = 0;
3091674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
3092674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
3093674ae819SStefano Zampini       if (size_of_constraint > 1) {
3094674ae819SStefano Zampini         n++;
3095674ae819SStefano Zampini       }
3096674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
3097674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
3098674ae819SStefano Zampini     }
3099811e8ca2SStefano Zampini     if (constraints_idx) {
3100785e854fSJed Brown       ierr = PetscMalloc1(n,&constraints_index);CHKERRQ(ierr);
3101785e854fSJed Brown       ierr = PetscMalloc1(max_size_of_constraint,&row_cmat_global_indices);CHKERRQ(ierr);
31024641a718SStefano Zampini       ierr = PetscBTCreate(local_size,&touched);CHKERRQ(ierr);
3103674ae819SStefano Zampini       n = 0;
3104674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
3105674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
3106674ae819SStefano Zampini         if (size_of_constraint > 1) {
3107674ae819SStefano Zampini           ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
310882d3d8afSStefano Zampini           /* find first untouched local node */
310982d3d8afSStefano Zampini           j = 0;
31104641a718SStefano Zampini           while (PetscBTLookup(touched,row_cmat_indices[j])) j++;
311182d3d8afSStefano Zampini           min_index = row_cmat_global_indices[j];
311282d3d8afSStefano Zampini           min_loc = j;
311382d3d8afSStefano Zampini           /* search the minimum among nodes not yet touched on the connected component
311482d3d8afSStefano Zampini              since there can be more than one constraint on a single cc */
3115674ae819SStefano Zampini           for (j=1;j<size_of_constraint;j++) {
31164641a718SStefano Zampini             if (!PetscBTLookup(touched,row_cmat_indices[j]) && min_index > row_cmat_global_indices[j]) {
3117674ae819SStefano Zampini               min_index = row_cmat_global_indices[j];
3118674ae819SStefano Zampini               min_loc = j;
3119674ae819SStefano Zampini             }
3120674ae819SStefano Zampini           }
31214641a718SStefano Zampini           ierr = PetscBTSet(touched,row_cmat_indices[min_loc]);CHKERRQ(ierr);
3122674ae819SStefano Zampini           constraints_index[n++] = row_cmat_indices[min_loc];
3123674ae819SStefano Zampini         }
3124674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
3125674ae819SStefano Zampini       }
31264641a718SStefano Zampini       ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
3127674ae819SStefano Zampini       ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
3128811e8ca2SStefano Zampini     }
3129811e8ca2SStefano Zampini   }
3130674ae819SStefano Zampini   *n_constraints = n;
3131811e8ca2SStefano Zampini   if (constraints_idx) *constraints_idx = constraints_index;
3132674ae819SStefano Zampini   PetscFunctionReturn(0);
3133674ae819SStefano Zampini }
3134674ae819SStefano Zampini 
3135674ae819SStefano Zampini #undef __FUNCT__
3136674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
3137674ae819SStefano 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[])
3138674ae819SStefano Zampini {
3139674ae819SStefano Zampini   Vec            local_vec,global_vec;
3140674ae819SStefano Zampini   IS             seqis,paris;
3141674ae819SStefano Zampini   VecScatter     scatter_ctx;
3142674ae819SStefano Zampini   PetscScalar    *array;
3143674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
3144674ae819SStefano Zampini   PetscScalar    globalsum;
3145674ae819SStefano Zampini   PetscInt       i,j,s;
314617ccb9bdSStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local,max_global;
314717ccb9bdSStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm;
314817ccb9bdSStefano Zampini   PetscInt       *dof_sizes,*dof_displs;
3149674ae819SStefano Zampini   PetscBool      first_found;
3150674ae819SStefano Zampini   PetscErrorCode ierr;
3151674ae819SStefano Zampini 
3152674ae819SStefano Zampini   PetscFunctionBegin;
3153674ae819SStefano Zampini   /* mpi buffers */
3154b9b85e73SStefano Zampini   ierr = MPI_Comm_size(comm,&size_prec_comm);CHKERRQ(ierr);
3155b9b85e73SStefano Zampini   ierr = MPI_Comm_rank(comm,&rank_prec_comm);CHKERRQ(ierr);
3156674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
315717ccb9bdSStefano Zampini   ierr = PetscMalloc2(j,&dof_sizes,j,&dof_displs);CHKERRQ(ierr);
3158674ae819SStefano Zampini   /* get maximum size of subset */
3159785e854fSJed Brown   ierr = PetscMalloc1(n_local_dofs,&temp_global_dofs);CHKERRQ(ierr);
3160674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
3161674ae819SStefano Zampini   max_local = 0;
3162b9b85e73SStefano Zampini   for (i=0;i<n_local_dofs;i++) {
3163674ae819SStefano Zampini     if (max_local < temp_global_dofs[i] ) {
3164674ae819SStefano Zampini       max_local = temp_global_dofs[i];
3165674ae819SStefano Zampini     }
3166674ae819SStefano Zampini   }
3167b9b85e73SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);CHKERRQ(ierr);
3168674ae819SStefano Zampini   max_global++;
3169674ae819SStefano Zampini   max_local = 0;
3170b9b85e73SStefano Zampini   for (i=0;i<n_local_dofs;i++) {
3171674ae819SStefano Zampini     if (max_local < local_dofs[i] ) {
3172674ae819SStefano Zampini       max_local = local_dofs[i];
3173674ae819SStefano Zampini     }
3174674ae819SStefano Zampini   }
3175674ae819SStefano Zampini   max_local++;
3176674ae819SStefano Zampini   /* allocate workspace */
3177674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
3178674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
3179674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
3180674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
3181674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
3182674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
3183674ae819SStefano Zampini   /* create scatter */
3184674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
3185674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
3186674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
3187674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
3188674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
3189674ae819SStefano Zampini   /* init array */
3190674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
3191674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
3192674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
3193674ae819SStefano Zampini   if (local_dofs_mult) {
3194674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
3195674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
3196674ae819SStefano Zampini     }
3197674ae819SStefano Zampini   } else {
3198674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
3199674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
3200674ae819SStefano Zampini     }
3201674ae819SStefano Zampini   }
3202674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
3203674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
3204674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3205674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3206674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
32075b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
3208674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
3209674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
3210674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
3211674ae819SStefano Zampini   nlocals = 0;
3212674ae819SStefano Zampini   first_index = -1;
3213674ae819SStefano Zampini   first_found = PETSC_FALSE;
3214674ae819SStefano Zampini   for (i=0;i<s;i++) {
3215b9b85e73SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.1) {
3216674ae819SStefano Zampini       first_found = PETSC_TRUE;
3217674ae819SStefano Zampini       first_index = i;
3218674ae819SStefano Zampini     }
32195b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
3220674ae819SStefano Zampini   }
3221674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
3222674ae819SStefano Zampini   if (!rank_prec_comm) {
3223674ae819SStefano Zampini     dof_displs[0]=0;
3224674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
3225674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
3226674ae819SStefano Zampini     }
3227674ae819SStefano Zampini   }
3228674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
3229674ae819SStefano Zampini   if (first_found) {
3230674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
3231674ae819SStefano Zampini     old_index = first_index;
3232674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
3233b9b85e73SStefano Zampini       if (PetscRealPart(array[i]) > 0.1) {
3234674ae819SStefano Zampini         array[i] += array[old_index];
3235674ae819SStefano Zampini         old_index = i;
3236674ae819SStefano Zampini       }
3237674ae819SStefano Zampini     }
3238674ae819SStefano Zampini   }
3239674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
3240674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
3241674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3242674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3243674ae819SStefano Zampini   /* get global ordering of local dofs */
32442b095fd8SStefano Zampini   ierr = VecGetArrayRead(local_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
3245674ae819SStefano Zampini   if (local_dofs_mult) {
3246674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
32475b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
3248674ae819SStefano Zampini     }
3249674ae819SStefano Zampini   } else {
3250674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
32515b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
3252674ae819SStefano Zampini     }
3253674ae819SStefano Zampini   }
32542b095fd8SStefano Zampini   ierr = VecRestoreArrayRead(local_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
3255674ae819SStefano Zampini   /* free workspace */
3256674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
3257674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
3258674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
325917ccb9bdSStefano Zampini   ierr = PetscFree2(dof_sizes,dof_displs);CHKERRQ(ierr);
3260674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
3261674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
3262674ae819SStefano Zampini   PetscFunctionReturn(0);
3263674ae819SStefano Zampini }
32649a7d3425SStefano Zampini 
32659a7d3425SStefano Zampini #undef __FUNCT__
32669a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
32679a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
32689a7d3425SStefano Zampini {
32699a7d3425SStefano Zampini   PetscInt       i,j;
32709a7d3425SStefano Zampini   PetscScalar    *alphas;
32719a7d3425SStefano Zampini   PetscErrorCode ierr;
32729a7d3425SStefano Zampini 
32739a7d3425SStefano Zampini   PetscFunctionBegin;
32749a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
3275785e854fSJed Brown   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
32769a7d3425SStefano Zampini   for (i=0;i<n;i++) {
32779a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
32789a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
32799a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
32809a7d3425SStefano Zampini   }
32819a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
32829a7d3425SStefano Zampini   PetscFunctionReturn(0);
32839a7d3425SStefano Zampini }
32849a7d3425SStefano Zampini 
3285e7931f94SStefano Zampini #undef __FUNCT__
328670cf5478SStefano Zampini #define __FUNCT__ "MatISGetSubassemblingPattern"
328728143c3dSStefano Zampini PetscErrorCode MatISGetSubassemblingPattern(Mat mat, PetscInt n_subdomains, PetscBool contiguous, IS* is_sends)
3288e7931f94SStefano Zampini {
3289e7931f94SStefano Zampini   Mat             subdomain_adj;
3290e7931f94SStefano Zampini   IS              new_ranks,ranks_send_to;
3291e7931f94SStefano Zampini   MatPartitioning partitioner;
3292e7931f94SStefano Zampini   Mat_IS          *matis;
3293e7931f94SStefano Zampini   PetscInt        n_neighs,*neighs,*n_shared,**shared;
3294e7931f94SStefano Zampini   PetscInt        prank;
3295e7931f94SStefano Zampini   PetscMPIInt     size,rank,color;
3296e7931f94SStefano Zampini   PetscInt        *xadj,*adjncy,*oldranks;
3297e7931f94SStefano Zampini   PetscInt        *adjncy_wgt,*v_wgt,*is_indices,*ranks_send_to_idx;
32983837a79fSStefano Zampini   PetscInt        i,local_size,threshold=0;
3299e7931f94SStefano Zampini   PetscErrorCode  ierr;
33002b510759SStefano Zampini   PetscBool       use_vwgt=PETSC_FALSE,use_square=PETSC_FALSE;
3301e7931f94SStefano Zampini   PetscSubcomm    subcomm;
3302a57a6d2fSStefano Zampini 
3303e7931f94SStefano Zampini   PetscFunctionBegin;
33042b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_square",&use_square,NULL);CHKERRQ(ierr);
33052b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
33062b510759SStefano Zampini   ierr = PetscOptionsGetInt(NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
3307e7931f94SStefano Zampini 
3308e7931f94SStefano Zampini   /* Get info on mapping */
3309e7931f94SStefano Zampini   matis = (Mat_IS*)(mat->data);
3310e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&local_size);CHKERRQ(ierr);
3311e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
3312e7931f94SStefano Zampini 
3313e7931f94SStefano Zampini   /* build local CSR graph of subdomains' connectivity */
3314785e854fSJed Brown   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
3315e7931f94SStefano Zampini   xadj[0] = 0;
3316e7931f94SStefano Zampini   xadj[1] = PetscMax(n_neighs-1,0);
3317785e854fSJed Brown   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
3318785e854fSJed Brown   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
3319e7931f94SStefano Zampini 
33202b510759SStefano Zampini   if (threshold) {
3321d023bfaeSStefano Zampini     PetscInt xadj_count = 0;
33222b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
3323d023bfaeSStefano Zampini       if (n_shared[i] > threshold) {
3324d023bfaeSStefano Zampini         adjncy[xadj_count] = neighs[i];
3325d023bfaeSStefano Zampini         adjncy_wgt[xadj_count] = n_shared[i];
3326d023bfaeSStefano Zampini         xadj_count++;
3327e7931f94SStefano Zampini       }
3328e7931f94SStefano Zampini     }
3329d023bfaeSStefano Zampini     xadj[1] = xadj_count;
3330c8587f34SStefano Zampini   } else {
3331e7931f94SStefano Zampini     if (xadj[1]) {
3332e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy,&neighs[1],xadj[1]*sizeof(*adjncy));CHKERRQ(ierr);
3333e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy_wgt,&n_shared[1],xadj[1]*sizeof(*adjncy_wgt));CHKERRQ(ierr);
3334c8587f34SStefano Zampini     }
3335e7931f94SStefano Zampini   }
3336e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingRestoreInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
3337e7931f94SStefano Zampini   if (use_square) {
3338e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
3339e7931f94SStefano Zampini       adjncy_wgt[i] = adjncy_wgt[i]*adjncy_wgt[i];
3340e7931f94SStefano Zampini     }
3341e7931f94SStefano Zampini   }
3342e7931f94SStefano Zampini   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
3343e7931f94SStefano Zampini 
33443837a79fSStefano Zampini   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
3345e7931f94SStefano Zampini 
3346e7931f94SStefano Zampini   /*
3347e7931f94SStefano Zampini     Restrict work on active processes only.
3348e7931f94SStefano Zampini   */
3349e7931f94SStefano Zampini   ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&subcomm);CHKERRQ(ierr);
3350e7931f94SStefano Zampini   ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
3351e7931f94SStefano Zampini   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
33522b510759SStefano Zampini   ierr = PetscMPIIntCast(!local_size,&color);CHKERRQ(ierr);
3353d3531aaaSJed Brown   ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
3354e7931f94SStefano Zampini   if (color) {
3355e7931f94SStefano Zampini     ierr = PetscFree(xadj);CHKERRQ(ierr);
3356e7931f94SStefano Zampini     ierr = PetscFree(adjncy);CHKERRQ(ierr);
3357e7931f94SStefano Zampini     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
3358c8587f34SStefano Zampini   } else {
335928143c3dSStefano Zampini     PetscInt coarsening_ratio;
3360306c2d5bSBarry Smith     ierr = MPI_Comm_size(PetscSubcommChild(subcomm),&size);CHKERRQ(ierr);
3361785e854fSJed Brown     ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
3362e7931f94SStefano Zampini     prank = rank;
3363306c2d5bSBarry Smith     ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,PetscSubcommChild(subcomm));CHKERRQ(ierr);
33648002ef2cSStefano Zampini     /*
3365e7931f94SStefano Zampini     for (i=0;i<size;i++) {
3366e7931f94SStefano Zampini       PetscPrintf(subcomm->comm,"oldranks[%d] = %d\n",i,oldranks[i]);
3367c8587f34SStefano Zampini     }
33688002ef2cSStefano Zampini     */
3369e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
3370e7931f94SStefano Zampini       ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
3371c8587f34SStefano Zampini     }
3372e7931f94SStefano Zampini     ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
3373306c2d5bSBarry Smith     ierr = MatCreateMPIAdj(PetscSubcommChild(subcomm),1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
337422b6e8a2SStefano Zampini     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
3375e7931f94SStefano Zampini 
3376e7931f94SStefano Zampini     /* Partition */
3377306c2d5bSBarry Smith     ierr = MatPartitioningCreate(PetscSubcommChild(subcomm),&partitioner);CHKERRQ(ierr);
3378e7931f94SStefano Zampini     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
3379e7931f94SStefano Zampini     if (use_vwgt) {
33803837a79fSStefano Zampini       ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
3381e7931f94SStefano Zampini       v_wgt[0] = local_size;
3382e7931f94SStefano Zampini       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
3383c8587f34SStefano Zampini     }
338428143c3dSStefano Zampini     n_subdomains = PetscMin((PetscInt)size,n_subdomains);
338528143c3dSStefano Zampini     coarsening_ratio = size/n_subdomains;
338628143c3dSStefano Zampini     ierr = MatPartitioningSetNParts(partitioner,n_subdomains);CHKERRQ(ierr);
3387e7931f94SStefano Zampini     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
3388e7931f94SStefano Zampini     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
338922b6e8a2SStefano Zampini     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
3390e7931f94SStefano Zampini 
3391e7931f94SStefano Zampini     ierr = ISGetIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
339228143c3dSStefano Zampini     if (contiguous) {
339328143c3dSStefano Zampini       ranks_send_to_idx[0] = oldranks[is_indices[0]]; /* contiguos set of processes */
339428143c3dSStefano Zampini     } else {
339584ba6060SStefano Zampini       ranks_send_to_idx[0] = coarsening_ratio*oldranks[is_indices[0]]; /* scattered set of processes */
339628143c3dSStefano Zampini     }
3397e7931f94SStefano Zampini     ierr = ISRestoreIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
3398e7931f94SStefano Zampini     /* clean up */
3399e7931f94SStefano Zampini     ierr = PetscFree(oldranks);CHKERRQ(ierr);
3400e7931f94SStefano Zampini     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
3401e7931f94SStefano Zampini     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
3402e7931f94SStefano Zampini     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
3403e7931f94SStefano Zampini   }
3404e7931f94SStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
3405e7931f94SStefano Zampini 
3406e7931f94SStefano Zampini   /* assemble parallel IS for sends */
3407e7931f94SStefano Zampini   i = 1;
3408e7931f94SStefano Zampini   if (color) i=0;
3409e7931f94SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,&ranks_send_to);CHKERRQ(ierr);
3410e7931f94SStefano Zampini 
3411e7931f94SStefano Zampini   /* get back IS */
3412e7931f94SStefano Zampini   *is_sends = ranks_send_to;
3413e7931f94SStefano Zampini   PetscFunctionReturn(0);
3414e7931f94SStefano Zampini }
3415e7931f94SStefano Zampini 
3416e7931f94SStefano Zampini typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
3417e7931f94SStefano Zampini 
3418e7931f94SStefano Zampini #undef __FUNCT__
3419e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble"
342028143c3dSStefano Zampini PetscErrorCode MatISSubassemble(Mat mat, IS is_sends, PetscInt n_subdomains, PetscBool restrict_comm, MatReuse reuse, Mat *mat_n, PetscInt nis, IS isarray[])
3421e7931f94SStefano Zampini {
342270cf5478SStefano Zampini   Mat                    local_mat;
3423e7931f94SStefano Zampini   Mat_IS                 *matis;
3424e7931f94SStefano Zampini   IS                     is_sends_internal;
34259d30be91SStefano Zampini   PetscInt               rows,cols,new_local_rows;
342628143c3dSStefano Zampini   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals;
34279d30be91SStefano Zampini   PetscBool              ismatis,isdense,newisdense,destroy_mat;
3428e7931f94SStefano Zampini   ISLocalToGlobalMapping l2gmap;
3429e7931f94SStefano Zampini   PetscInt*              l2gmap_indices;
3430e7931f94SStefano Zampini   const PetscInt*        is_indices;
3431e7931f94SStefano Zampini   MatType                new_local_type;
3432e7931f94SStefano Zampini   /* buffers */
3433e7931f94SStefano Zampini   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
343428143c3dSStefano Zampini   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
34359d30be91SStefano Zampini   PetscInt               *recv_buffer_idxs_local;
3436e7931f94SStefano Zampini   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
3437e7931f94SStefano Zampini   /* MPI */
343828143c3dSStefano Zampini   MPI_Comm               comm,comm_n;
343928143c3dSStefano Zampini   PetscSubcomm           subcomm;
3440e7931f94SStefano Zampini   PetscMPIInt            n_sends,n_recvs,commsize;
344128143c3dSStefano Zampini   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
344228143c3dSStefano Zampini   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
344328143c3dSStefano Zampini   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,source_dest;
344428143c3dSStefano Zampini   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals;
344528143c3dSStefano Zampini   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals;
3446e7931f94SStefano Zampini   PetscErrorCode         ierr;
3447e7931f94SStefano Zampini 
3448e7931f94SStefano Zampini   PetscFunctionBegin;
344928143c3dSStefano Zampini   /* TODO: add missing checks */
345028143c3dSStefano Zampini   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
345128143c3dSStefano Zampini   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
345228143c3dSStefano Zampini   PetscValidLogicalCollectiveEnum(mat,reuse,5);
345328143c3dSStefano Zampini   PetscValidLogicalCollectiveInt(mat,nis,7);
3454e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
345528143c3dSStefano Zampini   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",__FUNCT__);
3456e7931f94SStefano Zampini   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
3457e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
3458e7931f94SStefano Zampini   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
3459e7931f94SStefano Zampini   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
3460e7931f94SStefano Zampini   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
346128143c3dSStefano Zampini   if (reuse == MAT_REUSE_MATRIX && *mat_n) {
346270cf5478SStefano Zampini     PetscInt mrows,mcols,mnrows,mncols;
346370cf5478SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
346428143c3dSStefano Zampini     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
346570cf5478SStefano Zampini     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
346670cf5478SStefano Zampini     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
346770cf5478SStefano Zampini     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
346870cf5478SStefano Zampini     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
346970cf5478SStefano Zampini   }
3470e7931f94SStefano Zampini   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
3471e7931f94SStefano Zampini   PetscValidLogicalCollectiveInt(mat,bs,0);
3472e7931f94SStefano Zampini   /* prepare IS for sending if not provided */
3473e7931f94SStefano Zampini   if (!is_sends) {
347428143c3dSStefano Zampini     PetscBool pcontig = PETSC_TRUE;
347528143c3dSStefano Zampini     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
347628143c3dSStefano Zampini     ierr = MatISGetSubassemblingPattern(mat,n_subdomains,pcontig,&is_sends_internal);CHKERRQ(ierr);
3477c8587f34SStefano Zampini   } else {
3478e7931f94SStefano Zampini     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
3479e7931f94SStefano Zampini     is_sends_internal = is_sends;
3480c8587f34SStefano Zampini   }
3481e7931f94SStefano Zampini 
3482e7931f94SStefano Zampini   /* get pointer of MATIS data */
3483e7931f94SStefano Zampini   matis = (Mat_IS*)mat->data;
3484e7931f94SStefano Zampini 
3485e7931f94SStefano Zampini   /* get comm */
3486a316fed8SStefano Zampini   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
3487e7931f94SStefano Zampini 
3488e7931f94SStefano Zampini   /* compute number of sends */
3489e7931f94SStefano Zampini   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
3490e7931f94SStefano Zampini   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
3491e7931f94SStefano Zampini 
3492e7931f94SStefano Zampini   /* compute number of receives */
3493e7931f94SStefano Zampini   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
3494785e854fSJed Brown   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
3495e7931f94SStefano Zampini   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
3496e7931f94SStefano Zampini   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
3497e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
3498e7931f94SStefano Zampini   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
3499e7931f94SStefano Zampini   ierr = PetscFree(iflags);CHKERRQ(ierr);
3500e7931f94SStefano Zampini 
350128143c3dSStefano Zampini   /* restrict comm if requested */
350228143c3dSStefano Zampini   subcomm = 0;
350328143c3dSStefano Zampini   destroy_mat = PETSC_FALSE;
350428143c3dSStefano Zampini   if (restrict_comm) {
3505779c1cceSStefano Zampini     PetscMPIInt color,subcommsize;
3506779c1cceSStefano Zampini 
350728143c3dSStefano Zampini     color = 0;
3508779c1cceSStefano Zampini     if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm */
350928143c3dSStefano Zampini     ierr = MPI_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
351028143c3dSStefano Zampini     subcommsize = commsize - subcommsize;
351128143c3dSStefano Zampini     /* check if reuse has been requested */
351228143c3dSStefano Zampini     if (reuse == MAT_REUSE_MATRIX) {
351328143c3dSStefano Zampini       if (*mat_n) {
351428143c3dSStefano Zampini         PetscMPIInt subcommsize2;
351528143c3dSStefano Zampini         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
351628143c3dSStefano Zampini         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
351728143c3dSStefano Zampini         comm_n = PetscObjectComm((PetscObject)*mat_n);
351828143c3dSStefano Zampini       } else {
351928143c3dSStefano Zampini         comm_n = PETSC_COMM_SELF;
352028143c3dSStefano Zampini       }
352128143c3dSStefano Zampini     } else { /* MAT_INITIAL_MATRIX */
3522779c1cceSStefano Zampini       PetscMPIInt rank;
3523779c1cceSStefano Zampini 
3524779c1cceSStefano Zampini       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
352528143c3dSStefano Zampini       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
352628143c3dSStefano Zampini       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
352728143c3dSStefano Zampini       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
3528306c2d5bSBarry Smith       comm_n = PetscSubcommChild(subcomm);
352928143c3dSStefano Zampini     }
353028143c3dSStefano Zampini     /* flag to destroy *mat_n if not significative */
353128143c3dSStefano Zampini     if (color) destroy_mat = PETSC_TRUE;
353228143c3dSStefano Zampini   } else {
353328143c3dSStefano Zampini     comm_n = comm;
353428143c3dSStefano Zampini   }
353528143c3dSStefano Zampini 
3536e7931f94SStefano Zampini   /* prepare send/receive buffers */
3537785e854fSJed Brown   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
3538e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
3539785e854fSJed Brown   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
3540e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
354128143c3dSStefano Zampini   if (nis) {
3542854ce69bSBarry Smith     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
354328143c3dSStefano Zampini   }
3544e7931f94SStefano Zampini 
354528143c3dSStefano Zampini   /* Get data from local matrices */
3546e7931f94SStefano Zampini   if (!isdense) {
3547a26c9d0eSStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
3548e7931f94SStefano Zampini     /* TODO: See below some guidelines on how to prepare the local buffers */
3549e7931f94SStefano Zampini     /*
3550e7931f94SStefano Zampini        send_buffer_vals should contain the raw values of the local matrix
3551e7931f94SStefano Zampini        send_buffer_idxs should contain:
3552e7931f94SStefano Zampini        - MatType_PRIVATE type
3553e7931f94SStefano Zampini        - PetscInt        size_of_l2gmap
3554e7931f94SStefano Zampini        - PetscInt        global_row_indices[size_of_l2gmap]
3555e7931f94SStefano Zampini        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
3556e7931f94SStefano Zampini     */
3557e7931f94SStefano Zampini   } else {
3558e7931f94SStefano Zampini     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
3559e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&i);CHKERRQ(ierr);
3560854ce69bSBarry Smith     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
3561e7931f94SStefano Zampini     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
3562e7931f94SStefano Zampini     send_buffer_idxs[1] = i;
3563e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
3564e7931f94SStefano Zampini     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
3565e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingRestoreIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
3566e7931f94SStefano Zampini     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
3567e7931f94SStefano Zampini     for (i=0;i<n_sends;i++) {
3568e7931f94SStefano Zampini       ilengths_vals[is_indices[i]] = len*len;
3569e7931f94SStefano Zampini       ilengths_idxs[is_indices[i]] = len+2;
3570c8587f34SStefano Zampini     }
3571c8587f34SStefano Zampini   }
3572e7931f94SStefano Zampini   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
357328143c3dSStefano Zampini   /* additional is (if any) */
357428143c3dSStefano Zampini   if (nis) {
357528143c3dSStefano Zampini     PetscMPIInt psum;
357628143c3dSStefano Zampini     PetscInt j;
357728143c3dSStefano Zampini     for (j=0,psum=0;j<nis;j++) {
357828143c3dSStefano Zampini       PetscInt plen;
357928143c3dSStefano Zampini       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
358028143c3dSStefano Zampini       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
358128143c3dSStefano Zampini       psum += len+1; /* indices + lenght */
358228143c3dSStefano Zampini     }
3583854ce69bSBarry Smith     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
358428143c3dSStefano Zampini     for (j=0,psum=0;j<nis;j++) {
358528143c3dSStefano Zampini       PetscInt plen;
358628143c3dSStefano Zampini       const PetscInt *is_array_idxs;
358728143c3dSStefano Zampini       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
358828143c3dSStefano Zampini       send_buffer_idxs_is[psum] = plen;
358928143c3dSStefano Zampini       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
359028143c3dSStefano Zampini       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
359128143c3dSStefano Zampini       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
359228143c3dSStefano Zampini       psum += plen+1; /* indices + lenght */
359328143c3dSStefano Zampini     }
359428143c3dSStefano Zampini     for (i=0;i<n_sends;i++) {
359528143c3dSStefano Zampini       ilengths_idxs_is[is_indices[i]] = psum;
359628143c3dSStefano Zampini     }
359728143c3dSStefano Zampini     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
359828143c3dSStefano Zampini   }
359928143c3dSStefano Zampini 
3600e7931f94SStefano Zampini   buf_size_idxs = 0;
3601e7931f94SStefano Zampini   buf_size_vals = 0;
360228143c3dSStefano Zampini   buf_size_idxs_is = 0;
3603e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3604e7931f94SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
3605e7931f94SStefano Zampini     buf_size_vals += (PetscInt)olengths_vals[i];
360628143c3dSStefano Zampini     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
3607e7931f94SStefano Zampini   }
3608785e854fSJed Brown   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
3609785e854fSJed Brown   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
361095ecbf38SStefano Zampini   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
3611e7931f94SStefano Zampini 
3612e7931f94SStefano Zampini   /* get new tags for clean communications */
3613e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
3614e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
361528143c3dSStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
3616e7931f94SStefano Zampini 
3617e7931f94SStefano Zampini   /* allocate for requests */
3618785e854fSJed Brown   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
3619785e854fSJed Brown   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
362095ecbf38SStefano Zampini   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
3621785e854fSJed Brown   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
3622785e854fSJed Brown   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
362395ecbf38SStefano Zampini   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
3624e7931f94SStefano Zampini 
3625e7931f94SStefano Zampini   /* communications */
3626e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
3627e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
362828143c3dSStefano Zampini   ptr_idxs_is = recv_buffer_idxs_is;
3629e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3630e7931f94SStefano Zampini     source_dest = onodes[i];
3631e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
3632e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
3633e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3634e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
363528143c3dSStefano Zampini     if (nis) {
363628143c3dSStefano 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);
363728143c3dSStefano Zampini       ptr_idxs_is += olengths_idxs_is[i];
363828143c3dSStefano Zampini     }
3639e7931f94SStefano Zampini   }
3640e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) {
3641e7931f94SStefano Zampini     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
3642e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
3643e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
364428143c3dSStefano Zampini     if (nis) {
364528143c3dSStefano 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);
364628143c3dSStefano Zampini     }
3647e7931f94SStefano Zampini   }
3648e7931f94SStefano Zampini   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
3649e7931f94SStefano Zampini   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
3650e7931f94SStefano Zampini 
3651e7931f94SStefano Zampini   /* assemble new l2g map */
3652e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3653e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
36549d30be91SStefano Zampini   new_local_rows = 0;
3655e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
36569d30be91SStefano Zampini     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
3657e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3658e7931f94SStefano Zampini   }
36599d30be91SStefano Zampini   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
3660e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
36619d30be91SStefano Zampini   new_local_rows = 0;
3662e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
36639d30be91SStefano Zampini     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
36649d30be91SStefano Zampini     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
3665e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3666e7931f94SStefano Zampini   }
36679d30be91SStefano Zampini   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
36689d30be91SStefano Zampini   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
3669e7931f94SStefano Zampini   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
3670e7931f94SStefano Zampini 
3671e7931f94SStefano Zampini   /* infer new local matrix type from received local matrices type */
3672e7931f94SStefano Zampini   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
3673e7931f94SStefano 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) */
3674e7931f94SStefano Zampini   if (n_recvs) {
367528143c3dSStefano Zampini     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
3676e7931f94SStefano Zampini     ptr_idxs = recv_buffer_idxs;
3677e7931f94SStefano Zampini     for (i=0;i<n_recvs;i++) {
3678e7931f94SStefano Zampini       if ((PetscInt)new_local_type_private != *ptr_idxs) {
3679e7931f94SStefano Zampini         new_local_type_private = MATAIJ_PRIVATE;
3680e7931f94SStefano Zampini         break;
3681e7931f94SStefano Zampini       }
3682e7931f94SStefano Zampini       ptr_idxs += olengths_idxs[i];
3683e7931f94SStefano Zampini     }
3684e7931f94SStefano Zampini     switch (new_local_type_private) {
368528143c3dSStefano Zampini       case MATDENSE_PRIVATE:
368628143c3dSStefano Zampini         if (n_recvs>1) { /* subassembling of dense matrices does not give a dense matrix! */
3687e7931f94SStefano Zampini           new_local_type = MATSEQAIJ;
3688e7931f94SStefano Zampini           bs = 1;
368928143c3dSStefano Zampini         } else { /* if I receive only 1 dense matrix */
369028143c3dSStefano Zampini           new_local_type = MATSEQDENSE;
369128143c3dSStefano Zampini           bs = 1;
369228143c3dSStefano Zampini         }
3693e7931f94SStefano Zampini         break;
3694e7931f94SStefano Zampini       case MATAIJ_PRIVATE:
3695e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
3696e7931f94SStefano Zampini         bs = 1;
3697e7931f94SStefano Zampini         break;
3698e7931f94SStefano Zampini       case MATBAIJ_PRIVATE:
3699e7931f94SStefano Zampini         new_local_type = MATSEQBAIJ;
3700e7931f94SStefano Zampini         break;
3701e7931f94SStefano Zampini       case MATSBAIJ_PRIVATE:
3702e7931f94SStefano Zampini         new_local_type = MATSEQSBAIJ;
3703e7931f94SStefano Zampini         break;
3704e7931f94SStefano Zampini       default:
37059d30be91SStefano Zampini         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,__FUNCT__);
3706e7931f94SStefano Zampini         break;
3707e7931f94SStefano Zampini     }
370828143c3dSStefano Zampini   } else { /* by default, new_local_type is seqdense */
370928143c3dSStefano Zampini     new_local_type = MATSEQDENSE;
371028143c3dSStefano Zampini     bs = 1;
3711e7931f94SStefano Zampini   }
3712e7931f94SStefano Zampini 
371370cf5478SStefano Zampini   /* create MATIS object if needed */
371470cf5478SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
3715e7931f94SStefano Zampini     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
371628143c3dSStefano Zampini     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,mat_n);CHKERRQ(ierr);
371770cf5478SStefano Zampini   } else {
371870cf5478SStefano Zampini     /* it also destroys the local matrices */
371970cf5478SStefano Zampini     ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
372070cf5478SStefano Zampini   }
372170cf5478SStefano Zampini   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
3722e7931f94SStefano Zampini   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
37239d30be91SStefano Zampini 
37249d30be91SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
37259d30be91SStefano Zampini 
37269d30be91SStefano Zampini   /* Global to local map of received indices */
37279d30be91SStefano Zampini   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
37289d30be91SStefano Zampini   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
37299d30be91SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
37309d30be91SStefano Zampini 
37319d30be91SStefano Zampini   /* restore attributes -> type of incoming data and its size */
37329d30be91SStefano Zampini   buf_size_idxs = 0;
37339d30be91SStefano Zampini   for (i=0;i<n_recvs;i++) {
37349d30be91SStefano Zampini     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
37359d30be91SStefano Zampini     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
37369d30be91SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
37379d30be91SStefano Zampini   }
37389d30be91SStefano Zampini   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
37399d30be91SStefano Zampini 
37409d30be91SStefano Zampini   /* set preallocation */
37419d30be91SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
37429d30be91SStefano Zampini   if (!newisdense) {
37439d30be91SStefano Zampini     PetscInt *new_local_nnz=0;
37449d30be91SStefano Zampini 
37459d30be91SStefano Zampini     ptr_vals = recv_buffer_vals;
37469d30be91SStefano Zampini     ptr_idxs = recv_buffer_idxs_local;
37479d30be91SStefano Zampini     if (n_recvs) {
37489d30be91SStefano Zampini       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
37499d30be91SStefano Zampini     }
37509d30be91SStefano Zampini     for (i=0;i<n_recvs;i++) {
37519d30be91SStefano Zampini       PetscInt j;
37529d30be91SStefano Zampini       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
37539d30be91SStefano Zampini         for (j=0;j<*(ptr_idxs+1);j++) {
37549d30be91SStefano Zampini           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
37559d30be91SStefano Zampini         }
37569d30be91SStefano Zampini       } else {
37579d30be91SStefano Zampini         /* TODO */
37589d30be91SStefano Zampini       }
37599d30be91SStefano Zampini       ptr_idxs += olengths_idxs[i];
37609d30be91SStefano Zampini     }
37619d30be91SStefano Zampini     if (new_local_nnz) {
37629d30be91SStefano Zampini       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
37639d30be91SStefano Zampini       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
37649d30be91SStefano Zampini       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
37659d30be91SStefano Zampini       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
37669d30be91SStefano Zampini       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
37679d30be91SStefano Zampini       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
37689d30be91SStefano Zampini     } else {
37699d30be91SStefano Zampini       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
37709d30be91SStefano Zampini     }
37719d30be91SStefano Zampini     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
37729d30be91SStefano Zampini   } else {
37739d30be91SStefano Zampini     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
37749d30be91SStefano Zampini   }
3775e7931f94SStefano Zampini 
3776e7931f94SStefano Zampini   /* set values */
3777e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
37789d30be91SStefano Zampini   ptr_idxs = recv_buffer_idxs_local;
3779e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3780e7931f94SStefano Zampini     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
3781e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
37829d30be91SStefano Zampini       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
3783e7931f94SStefano Zampini       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3784e7931f94SStefano Zampini       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3785e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
378628143c3dSStefano Zampini     } else {
378728143c3dSStefano Zampini       /* TODO */
3788e7931f94SStefano Zampini     }
3789e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3790e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
3791e7931f94SStefano Zampini   }
3792e7931f94SStefano Zampini   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3793e7931f94SStefano Zampini   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
379470cf5478SStefano Zampini   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
379570cf5478SStefano Zampini   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
37969d30be91SStefano Zampini   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
37979d30be91SStefano Zampini   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
3798e7931f94SStefano Zampini 
3799dfd14d43SStefano Zampini #if 0
380028143c3dSStefano Zampini   if (!restrict_comm) { /* check */
3801e7931f94SStefano Zampini     Vec       lvec,rvec;
3802e7931f94SStefano Zampini     PetscReal infty_error;
3803e7931f94SStefano Zampini 
38042a7a6963SBarry Smith     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
3805e7931f94SStefano Zampini     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
3806e7931f94SStefano Zampini     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
3807e7931f94SStefano Zampini     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
380870cf5478SStefano Zampini     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
3809e7931f94SStefano Zampini     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3810e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
3811e7931f94SStefano Zampini     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
3812e7931f94SStefano Zampini     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
3813e7931f94SStefano Zampini   }
381428143c3dSStefano Zampini #endif
3815e7931f94SStefano Zampini 
381628143c3dSStefano Zampini   /* assemble new additional is (if any) */
381728143c3dSStefano Zampini   if (nis) {
381828143c3dSStefano Zampini     PetscInt **temp_idxs,*count_is,j,psum;
381928143c3dSStefano Zampini 
382028143c3dSStefano Zampini     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3821854ce69bSBarry Smith     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
382228143c3dSStefano Zampini     ptr_idxs = recv_buffer_idxs_is;
382328143c3dSStefano Zampini     psum = 0;
382428143c3dSStefano Zampini     for (i=0;i<n_recvs;i++) {
382528143c3dSStefano Zampini       for (j=0;j<nis;j++) {
382628143c3dSStefano Zampini         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
382728143c3dSStefano Zampini         count_is[j] += plen; /* increment counting of buffer for j-th IS */
382828143c3dSStefano Zampini         psum += plen;
382928143c3dSStefano Zampini         ptr_idxs += plen+1; /* shift pointer to received data */
383028143c3dSStefano Zampini       }
383128143c3dSStefano Zampini     }
3832854ce69bSBarry Smith     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
3833854ce69bSBarry Smith     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
383428143c3dSStefano Zampini     for (i=1;i<nis;i++) {
383528143c3dSStefano Zampini       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
383628143c3dSStefano Zampini     }
383728143c3dSStefano Zampini     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
383828143c3dSStefano Zampini     ptr_idxs = recv_buffer_idxs_is;
383928143c3dSStefano Zampini     for (i=0;i<n_recvs;i++) {
384028143c3dSStefano Zampini       for (j=0;j<nis;j++) {
384128143c3dSStefano Zampini         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
384228143c3dSStefano Zampini         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
384328143c3dSStefano Zampini         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
384428143c3dSStefano Zampini         ptr_idxs += plen+1; /* shift pointer to received data */
384528143c3dSStefano Zampini       }
384628143c3dSStefano Zampini     }
384728143c3dSStefano Zampini     for (i=0;i<nis;i++) {
384828143c3dSStefano Zampini       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
384928143c3dSStefano Zampini       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
385028143c3dSStefano Zampini       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
385128143c3dSStefano Zampini     }
385228143c3dSStefano Zampini     ierr = PetscFree(count_is);CHKERRQ(ierr);
385328143c3dSStefano Zampini     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
385428143c3dSStefano Zampini     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
385528143c3dSStefano Zampini   }
3856e7931f94SStefano Zampini   /* free workspace */
385728143c3dSStefano Zampini   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
3858e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3859e7931f94SStefano Zampini   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
3860e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3861e7931f94SStefano Zampini   if (isdense) {
3862e7931f94SStefano Zampini     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
3863e7931f94SStefano Zampini     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
3864e7931f94SStefano Zampini   } else {
3865e7931f94SStefano Zampini     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
3866e7931f94SStefano Zampini   }
386728143c3dSStefano Zampini   if (nis) {
386828143c3dSStefano Zampini     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
386928143c3dSStefano Zampini     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
387028143c3dSStefano Zampini   }
3871e7931f94SStefano Zampini   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
3872e7931f94SStefano Zampini   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
387328143c3dSStefano Zampini   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
3874e7931f94SStefano Zampini   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
3875e7931f94SStefano Zampini   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
387628143c3dSStefano Zampini   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
3877e7931f94SStefano Zampini   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
3878e7931f94SStefano Zampini   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
3879e7931f94SStefano Zampini   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
3880e7931f94SStefano Zampini   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
3881e7931f94SStefano Zampini   ierr = PetscFree(onodes);CHKERRQ(ierr);
388228143c3dSStefano Zampini   if (nis) {
388328143c3dSStefano Zampini     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
388428143c3dSStefano Zampini     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
388528143c3dSStefano Zampini     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
388628143c3dSStefano Zampini   }
388728143c3dSStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
388828143c3dSStefano Zampini   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
388928143c3dSStefano Zampini     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
389028143c3dSStefano Zampini     for (i=0;i<nis;i++) {
389128143c3dSStefano Zampini       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
389228143c3dSStefano Zampini     }
389328143c3dSStefano Zampini   }
3894e7931f94SStefano Zampini   PetscFunctionReturn(0);
3895e7931f94SStefano Zampini }
3896a57a6d2fSStefano Zampini 
389712edc857SStefano Zampini /* temporary hack into ksp private data structure */
3898af0996ceSBarry Smith #include <petsc/private/kspimpl.h>
389912edc857SStefano Zampini 
3900c8587f34SStefano Zampini #undef __FUNCT__
3901c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
3902c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
3903c8587f34SStefano Zampini {
3904c8587f34SStefano Zampini   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
3905c8587f34SStefano Zampini   PC_IS                  *pcis = (PC_IS*)pc->data;
390620a2ab83SStefano Zampini   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
39079881197aSStefano Zampini   MatNullSpace           CoarseNullSpace=NULL;
390820a2ab83SStefano Zampini   ISLocalToGlobalMapping coarse_islg;
39096e683305SStefano Zampini   IS                     coarse_is,*isarray;
39106e683305SStefano Zampini   PetscInt               i,im_active=-1,active_procs=-1;
39116e683305SStefano Zampini   PetscInt               nis,nisdofs,nisneu;
3912f9eb5b7dSStefano Zampini   PC                     pc_temp;
3913c8587f34SStefano Zampini   PCType                 coarse_pc_type;
3914c8587f34SStefano Zampini   KSPType                coarse_ksp_type;
3915f9eb5b7dSStefano Zampini   PetscBool              multilevel_requested,multilevel_allowed;
39164f3a063dSStefano Zampini   PetscBool              isredundant,isbddc,isnn,coarse_reuse;
39176e683305SStefano Zampini   Mat                    t_coarse_mat_is;
39186e683305SStefano Zampini   PetscInt               void_procs,ncoarse_ml,ncoarse_ds,ncoarse;
39196e683305SStefano Zampini   PetscMPIInt            all_procs;
392074e2c79eSStefano Zampini   PetscBool              csin_ml,csin_ds,csin,csin_type_simple,redist;
392168457ee5SStefano Zampini   PetscBool              compute_vecs = PETSC_FALSE;
392222bc73bbSStefano Zampini   PetscScalar            *array;
39239881197aSStefano Zampini   PetscErrorCode         ierr;
3924fdc09c96SStefano Zampini 
3925c8587f34SStefano Zampini   PetscFunctionBegin;
3926c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
392768457ee5SStefano 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 */
3928fa7f1dd8SStefano Zampini     PetscInt ocoarse_size;
39295a75c04eSSatish Balay     compute_vecs = PETSC_TRUE;
3930fa7f1dd8SStefano Zampini     ocoarse_size = pcbddc->coarse_size;
3931f4ddd8eeSStefano Zampini     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3932f4ddd8eeSStefano Zampini     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
3933f4ddd8eeSStefano Zampini     /* see if we can avoid some work */
3934fa7f1dd8SStefano Zampini     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
3935fa7f1dd8SStefano Zampini       if (ocoarse_size != pcbddc->coarse_size) { /* ...but with different size, so reset it and set reuse flag to false */
3936727cdba6SStefano Zampini         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3937fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_FALSE;
3938fa7f1dd8SStefano Zampini       } else { /* we can safely reuse already computed coarse matrix */
3939fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_TRUE;
3940f4ddd8eeSStefano Zampini       }
3941fa7f1dd8SStefano Zampini     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
3942fa7f1dd8SStefano Zampini       coarse_reuse = PETSC_FALSE;
3943f4ddd8eeSStefano Zampini     }
394470cf5478SStefano Zampini     /* reset any subassembling information */
394570cf5478SStefano Zampini     ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
39466e683305SStefano Zampini     ierr = ISDestroy(&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
39476e683305SStefano Zampini   } else { /* primal space is unchanged, so we can reuse coarse matrix */
3948fa7f1dd8SStefano Zampini     coarse_reuse = PETSC_TRUE;
3949f4ddd8eeSStefano Zampini   }
3950c8587f34SStefano Zampini 
39516e683305SStefano Zampini   /* count "active" (i.e. with positive local size) and "void" processes */
39522b510759SStefano Zampini   im_active = !!(pcis->n);
39532b510759SStefano Zampini   ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
39546e683305SStefano Zampini   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&all_procs);CHKERRQ(ierr);
39556e683305SStefano Zampini   void_procs = all_procs-active_procs;
39566e683305SStefano Zampini   csin_type_simple = PETSC_TRUE;
395774e2c79eSStefano Zampini   redist = PETSC_FALSE;
395822bc73bbSStefano Zampini   if (pcbddc->current_level && void_procs) {
39596e683305SStefano Zampini     csin_ml = PETSC_TRUE;
39606e683305SStefano Zampini     ncoarse_ml = void_procs;
3961779c1cceSStefano Zampini     /* it has no sense to redistribute on a set of processors larger than the number of active processes */
3962779c1cceSStefano Zampini     if (pcbddc->redistribute_coarse > 0 && pcbddc->redistribute_coarse < active_procs) {
396318a45a71SStefano Zampini       csin_ds = PETSC_TRUE;
396418a45a71SStefano Zampini       ncoarse_ds = pcbddc->redistribute_coarse;
396518a45a71SStefano Zampini       redist = PETSC_TRUE;
396618a45a71SStefano Zampini     } else {
39676e683305SStefano Zampini       csin_ds = PETSC_TRUE;
3968779c1cceSStefano Zampini       ncoarse_ds = active_procs;
3969779c1cceSStefano Zampini       redist = PETSC_TRUE;
397018a45a71SStefano Zampini     }
39716e683305SStefano Zampini   } else {
39726e683305SStefano Zampini     csin_ml = PETSC_FALSE;
39736e683305SStefano Zampini     ncoarse_ml = all_procs;
39746e683305SStefano Zampini     if (void_procs) {
39756e683305SStefano Zampini       csin_ds = PETSC_TRUE;
39766e683305SStefano Zampini       ncoarse_ds = void_procs;
39776e683305SStefano Zampini       csin_type_simple = PETSC_FALSE;
39786e683305SStefano Zampini     } else {
3979779c1cceSStefano Zampini       if (pcbddc->redistribute_coarse > 0 && pcbddc->redistribute_coarse < all_procs) {
398074e2c79eSStefano Zampini         csin_ds = PETSC_TRUE;
398174e2c79eSStefano Zampini         ncoarse_ds = pcbddc->redistribute_coarse;
398274e2c79eSStefano Zampini         redist = PETSC_TRUE;
398374e2c79eSStefano Zampini       } else {
39846e683305SStefano Zampini         csin_ds = PETSC_FALSE;
39856e683305SStefano Zampini         ncoarse_ds = all_procs;
39866e683305SStefano Zampini       }
39876e683305SStefano Zampini     }
398874e2c79eSStefano Zampini   }
39896e683305SStefano Zampini 
39906e683305SStefano Zampini   /*
39916e683305SStefano Zampini     test if we can go multilevel: three conditions must be satisfied:
39926e683305SStefano Zampini     - we have not exceeded the number of levels requested
39936e683305SStefano Zampini     - we can actually subassemble the active processes
39946e683305SStefano Zampini     - we can find a suitable number of MPI processes where we can place the subassembled problem
39956e683305SStefano Zampini   */
39966e683305SStefano Zampini   multilevel_allowed = PETSC_FALSE;
39976e683305SStefano Zampini   multilevel_requested = PETSC_FALSE;
39986e683305SStefano Zampini   if (pcbddc->current_level < pcbddc->max_levels) {
39996e683305SStefano Zampini     multilevel_requested = PETSC_TRUE;
40006e683305SStefano Zampini     if (active_procs/pcbddc->coarsening_ratio < 2 || ncoarse_ml/pcbddc->coarsening_ratio < 2) {
4001f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_FALSE;
40022b510759SStefano Zampini     } else {
4003f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_TRUE;
4004c8587f34SStefano Zampini     }
4005c8587f34SStefano Zampini   }
40066e683305SStefano Zampini   /* determine number of process partecipating to coarse solver */
40076e683305SStefano Zampini   if (multilevel_allowed) {
40086e683305SStefano Zampini     ncoarse = ncoarse_ml;
40096e683305SStefano Zampini     csin = csin_ml;
401058da7f69SStefano Zampini     redist = PETSC_FALSE;
40116e683305SStefano Zampini   } else {
40126e683305SStefano Zampini     ncoarse = ncoarse_ds;
40136e683305SStefano Zampini     csin = csin_ds;
40146e683305SStefano Zampini   }
4015e7931f94SStefano Zampini 
4016abbbba34SStefano Zampini   /* creates temporary l2gmap and IS for coarse indexes */
4017abbbba34SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
4018abbbba34SStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
4019abbbba34SStefano Zampini 
4020abbbba34SStefano Zampini   /* creates temporary MATIS object for coarse matrix */
402122bc73bbSStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
402222bc73bbSStefano Zampini   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
402322bc73bbSStefano Zampini   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
402422bc73bbSStefano Zampini   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
4025b9b85e73SStefano Zampini #if 0
4026b9b85e73SStefano Zampini   {
4027b9b85e73SStefano Zampini     PetscViewer viewer;
4028b9b85e73SStefano Zampini     char filename[256];
4029b9b85e73SStefano Zampini     sprintf(filename,"local_coarse_mat%d.m",PetscGlobalRank);
4030b9b85e73SStefano Zampini     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4031b9b85e73SStefano Zampini     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4032b9b85e73SStefano Zampini     ierr = MatView(coarse_submat_dense,viewer);CHKERRQ(ierr);
4033b9b85e73SStefano Zampini     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4034b9b85e73SStefano Zampini   }
4035b9b85e73SStefano Zampini #endif
40366e683305SStefano 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);
40376e683305SStefano Zampini   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
40386e683305SStefano Zampini   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
40396e683305SStefano Zampini   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4040abbbba34SStefano Zampini   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
4041abbbba34SStefano Zampini 
40426e683305SStefano Zampini   /* compute dofs splitting and neumann boundaries for coarse dofs */
40436e683305SStefano Zampini   if (multilevel_allowed && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal) ) { /* protects from unneded computations */
40446e683305SStefano Zampini     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
40456e683305SStefano Zampini     const PetscInt         *idxs;
40466e683305SStefano Zampini     ISLocalToGlobalMapping tmap;
40476e683305SStefano Zampini 
40486e683305SStefano Zampini     /* create map between primal indices (in local representative ordering) and local primal numbering */
40490be93d54SStefano Zampini     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
40506e683305SStefano Zampini     /* allocate space for temporary storage */
4051854ce69bSBarry Smith     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
4052854ce69bSBarry Smith     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
40536e683305SStefano Zampini     /* allocate for IS array */
40546e683305SStefano Zampini     nisdofs = pcbddc->n_ISForDofsLocal;
40556e683305SStefano Zampini     nisneu = !!pcbddc->NeumannBoundariesLocal;
40566e683305SStefano Zampini     nis = nisdofs + nisneu;
4057854ce69bSBarry Smith     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
40586e683305SStefano Zampini     /* dofs splitting */
40596e683305SStefano Zampini     for (i=0;i<nisdofs;i++) {
40606e683305SStefano Zampini       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
40616e683305SStefano Zampini       ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
40626e683305SStefano Zampini       ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
40636e683305SStefano Zampini       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
40646e683305SStefano Zampini       ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
40656e683305SStefano Zampini       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
40666e683305SStefano Zampini       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pcbddc->ISForDofsLocal[i]),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
40676e683305SStefano Zampini       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
40686e683305SStefano Zampini     }
40696e683305SStefano Zampini     /* neumann boundaries */
40706e683305SStefano Zampini     if (pcbddc->NeumannBoundariesLocal) {
40716e683305SStefano Zampini       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
40726e683305SStefano Zampini       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
40736e683305SStefano Zampini       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
40746e683305SStefano Zampini       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
40756e683305SStefano Zampini       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
40766e683305SStefano Zampini       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
40776e683305SStefano Zampini       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pcbddc->NeumannBoundariesLocal),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
40786e683305SStefano Zampini       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
40796e683305SStefano Zampini     }
40806e683305SStefano Zampini     /* free memory */
40816e683305SStefano Zampini     ierr = PetscFree(tidxs);CHKERRQ(ierr);
40826e683305SStefano Zampini     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
40836e683305SStefano Zampini     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
40846e683305SStefano Zampini   } else {
40856e683305SStefano Zampini     nis = 0;
40866e683305SStefano Zampini     nisdofs = 0;
40876e683305SStefano Zampini     nisneu = 0;
40886e683305SStefano Zampini     isarray = NULL;
40896e683305SStefano Zampini   }
40906e683305SStefano Zampini   /* destroy no longer needed map */
40916e683305SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
40926e683305SStefano Zampini 
40936e683305SStefano Zampini   /* restrict on coarse candidates (if needed) */
40946e683305SStefano Zampini   coarse_mat_is = NULL;
40956e683305SStefano Zampini   if (csin) {
40966e683305SStefano Zampini     if (!pcbddc->coarse_subassembling_init ) { /* creates subassembling init pattern if not present */
409774e2c79eSStefano Zampini       if (redist) {
409874e2c79eSStefano Zampini         PetscMPIInt rank;
4099779c1cceSStefano Zampini         PetscInt    spc,n_spc_p1,dest[1],destsize;
410074e2c79eSStefano Zampini 
410174e2c79eSStefano Zampini         ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
410258da7f69SStefano Zampini         spc = active_procs/ncoarse;
410358da7f69SStefano Zampini         n_spc_p1 = active_procs%ncoarse;
4104779c1cceSStefano Zampini         if (im_active) {
4105779c1cceSStefano Zampini           destsize = 1;
410674e2c79eSStefano Zampini           if (rank > n_spc_p1*(spc+1)-1) {
410774e2c79eSStefano Zampini             dest[0] = n_spc_p1+(rank-(n_spc_p1*(spc+1)))/spc;
410874e2c79eSStefano Zampini           } else {
410974e2c79eSStefano Zampini             dest[0] = rank/(spc+1);
411074e2c79eSStefano Zampini           }
411174e2c79eSStefano Zampini         } else {
4112779c1cceSStefano Zampini           destsize = 0;
41136e683305SStefano Zampini         }
4114779c1cceSStefano Zampini         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),destsize,dest,PETSC_COPY_VALUES,&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
4115779c1cceSStefano Zampini       } else if (csin_type_simple) {
41166e683305SStefano Zampini         PetscMPIInt rank;
41176e683305SStefano Zampini         PetscInt    issize,isidx;
4118779c1cceSStefano Zampini 
41196e683305SStefano Zampini         ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
41206e683305SStefano Zampini         if (im_active) {
41216e683305SStefano Zampini           issize = 1;
41226e683305SStefano Zampini           isidx = (PetscInt)rank;
41236e683305SStefano Zampini         } else {
41246e683305SStefano Zampini           issize = 0;
41256e683305SStefano Zampini           isidx = -1;
41266e683305SStefano Zampini         }
41276e683305SStefano Zampini         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),issize,&isidx,PETSC_COPY_VALUES,&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
4128779c1cceSStefano Zampini       } else { /* get a suitable subassembling pattern from MATIS code */
41296e683305SStefano Zampini         ierr = MatISGetSubassemblingPattern(t_coarse_mat_is,ncoarse,PETSC_TRUE,&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
41306e683305SStefano Zampini       }
4131779c1cceSStefano Zampini 
4132779c1cceSStefano Zampini       /* we need to shift on coarse candidates either if we are not redistributing or we are redistributing and we have enough void processes */
4133779c1cceSStefano Zampini       if (!redist || ncoarse <= void_procs) {
4134779c1cceSStefano Zampini         PetscInt ncoarse_cand,tissize,*nisindices;
4135779c1cceSStefano Zampini         PetscInt *coarse_candidates;
4136779c1cceSStefano Zampini         const PetscInt* tisindices;
4137779c1cceSStefano Zampini 
4138779c1cceSStefano Zampini         /* get coarse candidates' ranks in pc communicator */
4139779c1cceSStefano Zampini         ierr = PetscMalloc1(all_procs,&coarse_candidates);CHKERRQ(ierr);
4140779c1cceSStefano Zampini         ierr = MPI_Allgather(&im_active,1,MPIU_INT,coarse_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4141779c1cceSStefano Zampini         for (i=0,ncoarse_cand=0;i<all_procs;i++) {
4142779c1cceSStefano Zampini           if (!coarse_candidates[i]) {
4143779c1cceSStefano Zampini             coarse_candidates[ncoarse_cand++]=i;
4144779c1cceSStefano Zampini           }
4145779c1cceSStefano Zampini         }
4146779c1cceSStefano Zampini         if (ncoarse_cand < ncoarse) SETERRQ2(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen! %d < %d",ncoarse_cand,ncoarse);
4147779c1cceSStefano Zampini 
4148779c1cceSStefano Zampini 
41496e683305SStefano Zampini         if (pcbddc->dbg_flag) {
41506e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
41516e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Subassembling pattern init (before shift)\n");CHKERRQ(ierr);
41526e683305SStefano Zampini           ierr = ISView(pcbddc->coarse_subassembling_init,pcbddc->dbg_viewer);CHKERRQ(ierr);
41536e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse candidates\n");CHKERRQ(ierr);
4154779c1cceSStefano Zampini           for (i=0;i<ncoarse_cand;i++) {
41556e683305SStefano Zampini             ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"%d ",coarse_candidates[i]);CHKERRQ(ierr);
41566e683305SStefano Zampini           }
41576e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"\n");CHKERRQ(ierr);
41586e683305SStefano Zampini           ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
41596e683305SStefano Zampini         }
41606e683305SStefano Zampini         /* shift the pattern on coarse candidates */
41616e683305SStefano Zampini         ierr = ISGetLocalSize(pcbddc->coarse_subassembling_init,&tissize);CHKERRQ(ierr);
41626e683305SStefano Zampini         ierr = ISGetIndices(pcbddc->coarse_subassembling_init,&tisindices);CHKERRQ(ierr);
4163854ce69bSBarry Smith         ierr = PetscMalloc1(tissize,&nisindices);CHKERRQ(ierr);
41646e683305SStefano Zampini         for (i=0;i<tissize;i++) nisindices[i] = coarse_candidates[tisindices[i]];
41656e683305SStefano Zampini         ierr = ISRestoreIndices(pcbddc->coarse_subassembling_init,&tisindices);CHKERRQ(ierr);
41666e683305SStefano Zampini         ierr = ISGeneralSetIndices(pcbddc->coarse_subassembling_init,tissize,nisindices,PETSC_OWN_POINTER);CHKERRQ(ierr);
41676e683305SStefano Zampini         ierr = PetscFree(coarse_candidates);CHKERRQ(ierr);
41686e683305SStefano Zampini       }
41696e683305SStefano Zampini       if (pcbddc->dbg_flag) {
41706e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
41716e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Subassembling pattern init\n");CHKERRQ(ierr);
41726e683305SStefano Zampini         ierr = ISView(pcbddc->coarse_subassembling_init,pcbddc->dbg_viewer);CHKERRQ(ierr);
41736e683305SStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
41746e683305SStefano Zampini       }
4175779c1cceSStefano Zampini     }
41766e683305SStefano Zampini     /* get temporary coarse mat in IS format restricted on coarse procs (plus additional index sets of isarray) */
41776e683305SStefano Zampini     ierr = MatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling_init,0,PETSC_TRUE,MAT_INITIAL_MATRIX,&coarse_mat_is,nis,isarray);CHKERRQ(ierr);
41786e683305SStefano Zampini   } else {
41796e683305SStefano Zampini     if (pcbddc->dbg_flag) {
41806e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
41816e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Subassembling pattern init not needed\n");CHKERRQ(ierr);
41826e683305SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
41836e683305SStefano Zampini     }
41846e683305SStefano Zampini     ierr = PetscObjectReference((PetscObject)t_coarse_mat_is);CHKERRQ(ierr);
41856e683305SStefano Zampini     coarse_mat_is = t_coarse_mat_is;
41866e683305SStefano Zampini   }
41876e683305SStefano Zampini 
41886e683305SStefano Zampini   /* create local to global scatters for coarse problem */
418968457ee5SStefano Zampini   if (compute_vecs) {
41906e683305SStefano Zampini     PetscInt lrows;
41916e683305SStefano Zampini     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
41926e683305SStefano Zampini     if (coarse_mat_is) {
41936e683305SStefano Zampini       ierr = MatGetLocalSize(coarse_mat_is,&lrows,NULL);CHKERRQ(ierr);
41946e683305SStefano Zampini     } else {
41956e683305SStefano Zampini       lrows = 0;
41966e683305SStefano Zampini     }
41976e683305SStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
41986e683305SStefano Zampini     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
41996e683305SStefano Zampini     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
42006e683305SStefano Zampini     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
42016e683305SStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
42026e683305SStefano Zampini   }
42036e683305SStefano Zampini   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
42046e683305SStefano Zampini   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
4205c8587f34SStefano Zampini 
4206f9eb5b7dSStefano Zampini   /* set defaults for coarse KSP and PC */
4207f9eb5b7dSStefano Zampini   if (multilevel_allowed) {
4208f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPRICHARDSON;
4209f9eb5b7dSStefano Zampini     coarse_pc_type = PCBDDC;
4210f9eb5b7dSStefano Zampini   } else {
4211f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPPREONLY;
4212f9eb5b7dSStefano Zampini     coarse_pc_type = PCREDUNDANT;
4213c8587f34SStefano Zampini   }
4214c8587f34SStefano Zampini 
42156e683305SStefano Zampini   /* print some info if requested */
42166e683305SStefano Zampini   if (pcbddc->dbg_flag) {
42176e683305SStefano Zampini     if (!multilevel_allowed) {
42186e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
42196e683305SStefano Zampini       if (multilevel_requested) {
42206e683305SStefano 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);
42216e683305SStefano Zampini       } else if (pcbddc->max_levels) {
42226e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
42236e683305SStefano Zampini       }
42246e683305SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
42256e683305SStefano Zampini     }
42266e683305SStefano Zampini   }
42276e683305SStefano Zampini 
4228f9eb5b7dSStefano Zampini   /* create the coarse KSP object only once with defaults */
42296e683305SStefano Zampini   if (coarse_mat_is) {
42306e683305SStefano Zampini     MatReuse coarse_mat_reuse;
42316a1308c2SStefano Zampini     PetscViewer dbg_viewer = NULL;
42326e683305SStefano Zampini     if (pcbddc->dbg_flag) {
42336e683305SStefano Zampini       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat_is));
42346e683305SStefano Zampini       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
42356e683305SStefano Zampini     }
4236f9eb5b7dSStefano Zampini     if (!pcbddc->coarse_ksp) {
4237312be037SStefano Zampini       char prefix[256],str_level[16];
4238e604994aSStefano Zampini       size_t len;
42396e683305SStefano Zampini       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat_is),&pcbddc->coarse_ksp);CHKERRQ(ierr);
4240c8587f34SStefano Zampini       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
4241f9eb5b7dSStefano Zampini       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
42425f76c7aeSStefano Zampini       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat_is,coarse_mat_is);CHKERRQ(ierr);
4243c8587f34SStefano Zampini       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
42446e683305SStefano Zampini       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
4245c8587f34SStefano Zampini       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
4246c8587f34SStefano Zampini       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
42473e3c6dadSStefano Zampini       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4248e604994aSStefano Zampini       /* prefix */
4249e604994aSStefano Zampini       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
4250e604994aSStefano Zampini       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
4251e604994aSStefano Zampini       if (!pcbddc->current_level) {
4252e604994aSStefano Zampini         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4253e604994aSStefano Zampini         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
4254c8587f34SStefano Zampini       } else {
4255e604994aSStefano Zampini         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
4256312be037SStefano Zampini         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
4257312be037SStefano Zampini         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
425834d6797cSStefano Zampini         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4259312be037SStefano Zampini         sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
4260e604994aSStefano Zampini         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
4261e604994aSStefano Zampini       }
4262e604994aSStefano Zampini       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
42633e3c6dadSStefano Zampini       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
42643e3c6dadSStefano Zampini       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
42653e3c6dadSStefano Zampini       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
42663e3c6dadSStefano Zampini       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
4267f9eb5b7dSStefano Zampini       /* allow user customization */
4268f9eb5b7dSStefano Zampini       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
42693e3c6dadSStefano Zampini     }
42703e3c6dadSStefano Zampini     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
42713e3c6dadSStefano Zampini     if (nisdofs) {
42723e3c6dadSStefano Zampini       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
42733e3c6dadSStefano Zampini       for (i=0;i<nisdofs;i++) {
42743e3c6dadSStefano Zampini         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
42753e3c6dadSStefano Zampini       }
42763e3c6dadSStefano Zampini     }
42773e3c6dadSStefano Zampini     if (nisneu) {
42783e3c6dadSStefano Zampini       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
42793e3c6dadSStefano Zampini       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
4280312be037SStefano Zampini     }
4281f9eb5b7dSStefano Zampini 
4282f9eb5b7dSStefano Zampini     /* get some info after set from options */
4283f9eb5b7dSStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
4284f9eb5b7dSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
4285f9eb5b7dSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
42864f3a063dSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
42876e683305SStefano Zampini     if (isbddc && !multilevel_allowed) { /* multilevel can only be requested via pc_bddc_set_levels */
4288f9eb5b7dSStefano Zampini       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
4289f9eb5b7dSStefano Zampini       isbddc = PETSC_FALSE;
4290f9eb5b7dSStefano Zampini     }
42914f3a063dSStefano Zampini     if (isredundant) {
42924f3a063dSStefano Zampini       KSP inner_ksp;
42934f3a063dSStefano Zampini       PC inner_pc;
42944f3a063dSStefano Zampini       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
42954f3a063dSStefano Zampini       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
42964f3a063dSStefano Zampini       ierr = PCFactorSetReuseFill(inner_pc,PETSC_TRUE);CHKERRQ(ierr);
42974f3a063dSStefano Zampini     }
4298f9eb5b7dSStefano Zampini 
4299f9eb5b7dSStefano Zampini     /* assemble coarse matrix */
4300fa7f1dd8SStefano Zampini     if (coarse_reuse) {
430181d9aea3SBarry Smith       ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
4302fa7f1dd8SStefano Zampini       ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
43036e683305SStefano Zampini       coarse_mat_reuse = MAT_REUSE_MATRIX;
4304fa7f1dd8SStefano Zampini     } else {
43056e683305SStefano Zampini       coarse_mat_reuse = MAT_INITIAL_MATRIX;
4306fa7f1dd8SStefano Zampini     }
4307c8587f34SStefano Zampini     if (isbddc || isnn) {
430822bc73bbSStefano Zampini       if (pcbddc->coarsening_ratio > 1) {
430970cf5478SStefano Zampini         if (!pcbddc->coarse_subassembling) { /* subassembling info is not present */
431028143c3dSStefano Zampini           ierr = MatISGetSubassemblingPattern(coarse_mat_is,active_procs/pcbddc->coarsening_ratio,PETSC_TRUE,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
431122b6e8a2SStefano Zampini           if (pcbddc->dbg_flag) {
43126e683305SStefano Zampini             ierr = PetscViewerASCIIPrintf(dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
43136e683305SStefano Zampini             ierr = PetscViewerASCIIPrintf(dbg_viewer,"Subassembling pattern\n");CHKERRQ(ierr);
43146e683305SStefano Zampini             ierr = ISView(pcbddc->coarse_subassembling,dbg_viewer);CHKERRQ(ierr);
43156e683305SStefano Zampini             ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
431622b6e8a2SStefano Zampini           }
431770cf5478SStefano Zampini         }
43186e683305SStefano Zampini         ierr = MatISSubassemble(coarse_mat_is,pcbddc->coarse_subassembling,0,PETSC_FALSE,coarse_mat_reuse,&coarse_mat,0,NULL);CHKERRQ(ierr);
431970cf5478SStefano Zampini       } else {
432022bc73bbSStefano Zampini         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
432122bc73bbSStefano Zampini         coarse_mat = coarse_mat_is;
432222bc73bbSStefano Zampini       }
432322bc73bbSStefano Zampini     } else {
43242e1e5fa4SStefano Zampini       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
4325c8587f34SStefano Zampini     }
4326c8587f34SStefano Zampini     ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
4327c8587f34SStefano Zampini 
4328c8587f34SStefano Zampini     /* propagate symmetry info to coarse matrix */
4329b9d89cd5SStefano Zampini     ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pcbddc->issym);CHKERRQ(ierr);
43305a16e3a0SStefano Zampini     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
4331c8587f34SStefano Zampini 
43326e683305SStefano Zampini     /* set operators */
43335f76c7aeSStefano Zampini     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
43346e683305SStefano Zampini     if (pcbddc->dbg_flag) {
43356e683305SStefano Zampini       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
43366e683305SStefano Zampini     }
43376e683305SStefano Zampini   } else { /* processes non partecipating to coarse solver (if any) */
43386e683305SStefano Zampini     coarse_mat = 0;
43396e683305SStefano Zampini   }
43406e683305SStefano Zampini   ierr = PetscFree(isarray);CHKERRQ(ierr);
4341b9b85e73SStefano Zampini #if 0
4342b9b85e73SStefano Zampini   {
4343b9b85e73SStefano Zampini     PetscViewer viewer;
4344b9b85e73SStefano Zampini     char filename[256];
4345b9b85e73SStefano Zampini     sprintf(filename,"coarse_mat.m");
4346b9b85e73SStefano Zampini     ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,filename,&viewer);CHKERRQ(ierr);
4347b9b85e73SStefano Zampini     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4348b9b85e73SStefano Zampini     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
4349b9b85e73SStefano Zampini     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4350b9b85e73SStefano Zampini   }
4351b9b85e73SStefano Zampini #endif
4352c8587f34SStefano Zampini 
4353c8587f34SStefano Zampini   /* Compute coarse null space (special handling by BDDC only) */
4354c8587f34SStefano Zampini   if (pcbddc->NullSpace) {
4355c8587f34SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,coarse_mat,&CoarseNullSpace);CHKERRQ(ierr);
435698a51de6SStefano Zampini   }
435798a51de6SStefano Zampini 
435898a51de6SStefano Zampini   if (pcbddc->coarse_ksp) {
435998a51de6SStefano Zampini     Vec crhs,csol;
436098a51de6SStefano Zampini     PetscBool ispreonly;
436198a51de6SStefano Zampini     if (CoarseNullSpace) {
4362c8587f34SStefano Zampini       if (isbddc) {
4363c8587f34SStefano Zampini         ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
4364c8587f34SStefano Zampini       } else {
4365c8587f34SStefano Zampini         ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
4366c8587f34SStefano Zampini       }
4367c8587f34SStefano Zampini     }
4368f9eb5b7dSStefano Zampini     /* setup coarse ksp */
4369f9eb5b7dSStefano Zampini     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
4370f347579bSStefano Zampini     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
4371f347579bSStefano Zampini     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
43726e683305SStefano Zampini     /* hack */
4373f347579bSStefano Zampini     if (!csol) {
43742a7a6963SBarry Smith       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
4375f9eb5b7dSStefano Zampini     }
4376f347579bSStefano Zampini     if (!crhs) {
43772a7a6963SBarry Smith       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
4378f347579bSStefano Zampini     }
4379cbcc2c2aSStefano Zampini     /* Check coarse problem if in debug mode or if solving with an iterative method */
4380cbcc2c2aSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
43816e683305SStefano Zampini     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
4382c8587f34SStefano Zampini       KSP       check_ksp;
43832b510759SStefano Zampini       KSPType   check_ksp_type;
4384c8587f34SStefano Zampini       PC        check_pc;
43856e683305SStefano Zampini       Vec       check_vec,coarse_vec;
43866a1308c2SStefano Zampini       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
43872b510759SStefano Zampini       PetscInt  its;
43886e683305SStefano Zampini       PetscBool compute_eigs;
43896e683305SStefano Zampini       PetscReal *eigs_r,*eigs_c;
43906e683305SStefano Zampini       PetscInt  neigs;
43918e185a42SStefano Zampini       const char *prefix;
4392c8587f34SStefano Zampini 
43932b510759SStefano Zampini       /* Create ksp object suitable for estimation of extreme eigenvalues */
43946e683305SStefano Zampini       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
439523ee1639SBarry Smith       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
4396f4ddd8eeSStefano Zampini       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
43972b510759SStefano Zampini       if (ispreonly) {
43982b510759SStefano Zampini         check_ksp_type = KSPPREONLY;
43996e683305SStefano Zampini         compute_eigs = PETSC_FALSE;
44002b510759SStefano Zampini       } else {
4401cbcc2c2aSStefano Zampini         check_ksp_type = KSPGMRES;
44026e683305SStefano Zampini         compute_eigs = PETSC_TRUE;
4403c8587f34SStefano Zampini       }
4404c8587f34SStefano Zampini       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
44056e683305SStefano Zampini       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
44066e683305SStefano Zampini       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
44076e683305SStefano Zampini       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
4408a7dc3881SStefano Zampini       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
4409a7dc3881SStefano Zampini       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
4410a7dc3881SStefano Zampini       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
4411a7dc3881SStefano Zampini       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
4412c8587f34SStefano Zampini       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
4413c8587f34SStefano Zampini       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
4414c8587f34SStefano Zampini       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
4415c8587f34SStefano Zampini       /* create random vec */
44166e683305SStefano Zampini       ierr = KSPGetSolution(pcbddc->coarse_ksp,&coarse_vec);CHKERRQ(ierr);
44176e683305SStefano Zampini       ierr = VecDuplicate(coarse_vec,&check_vec);CHKERRQ(ierr);
4418c8587f34SStefano Zampini       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
4419c8587f34SStefano Zampini       if (CoarseNullSpace) {
4420c8587f34SStefano Zampini         ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
4421c8587f34SStefano Zampini       }
44226e683305SStefano Zampini       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
4423c8587f34SStefano Zampini       /* solve coarse problem */
44246e683305SStefano Zampini       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
4425c8587f34SStefano Zampini       if (CoarseNullSpace) {
44266e683305SStefano Zampini         ierr = MatNullSpaceRemove(CoarseNullSpace,coarse_vec);CHKERRQ(ierr);
4427c8587f34SStefano Zampini       }
4428cbcc2c2aSStefano Zampini       /* set eigenvalue estimation if preonly has not been requested */
44296e683305SStefano Zampini       if (compute_eigs) {
4430854ce69bSBarry Smith         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
4431854ce69bSBarry Smith         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
44326e683305SStefano Zampini         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
44336e683305SStefano Zampini         lambda_max = eigs_r[neigs-1];
44346e683305SStefano Zampini         lambda_min = eigs_r[0];
44356e683305SStefano Zampini         if (pcbddc->use_coarse_estimates) {
44366e683305SStefano Zampini           if (lambda_max>lambda_min) {
4437cbcc2c2aSStefano Zampini             ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max,lambda_min);CHKERRQ(ierr);
4438cbcc2c2aSStefano Zampini             ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
4439cbcc2c2aSStefano Zampini           }
4440c8587f34SStefano Zampini         }
4441c8587f34SStefano Zampini       }
4442cbcc2c2aSStefano Zampini 
4443c8587f34SStefano Zampini       /* check coarse problem residual error */
44446e683305SStefano Zampini       if (pcbddc->dbg_flag) {
44456e683305SStefano Zampini         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
44466e683305SStefano Zampini         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
44476e683305SStefano Zampini         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
4448c8587f34SStefano Zampini         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
44496e683305SStefano Zampini         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
44506e683305SStefano Zampini         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
4451c8587f34SStefano Zampini         ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
4452779c1cceSStefano Zampini         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
44536e683305SStefano Zampini         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
44546e683305SStefano Zampini         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
44556e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
44566e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
44576e683305SStefano Zampini         if (compute_eigs) {
44586e683305SStefano Zampini           PetscReal lambda_max_s,lambda_min_s;
4459deec49d1SStefano Zampini           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
4460c8587f34SStefano Zampini           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
44616e683305SStefano Zampini           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
44626e683305SStefano 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);
44636e683305SStefano Zampini           for (i=0;i<neigs;i++) {
44646e683305SStefano Zampini             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
4465c8587f34SStefano Zampini           }
44666e683305SStefano Zampini         }
44676e683305SStefano Zampini         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
44686e683305SStefano Zampini         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
44696e683305SStefano Zampini       }
4470c8587f34SStefano Zampini       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
44716e683305SStefano Zampini       if (compute_eigs) {
44726e683305SStefano Zampini         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
44736e683305SStefano Zampini         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
4474c8587f34SStefano Zampini       }
44756e683305SStefano Zampini     }
44766e683305SStefano Zampini   }
4477cbcc2c2aSStefano Zampini   /* print additional info */
4478cbcc2c2aSStefano Zampini   if (pcbddc->dbg_flag) {
44796e683305SStefano Zampini     /* waits until all processes reaches this point */
44806e683305SStefano Zampini     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
4481cbcc2c2aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
4482cbcc2c2aSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4483cbcc2c2aSStefano Zampini   }
4484cbcc2c2aSStefano Zampini 
44852b510759SStefano Zampini   /* free memory */
4486c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
4487fdc635d7SStefano Zampini   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
4488c8587f34SStefano Zampini   PetscFunctionReturn(0);
4489c8587f34SStefano Zampini }
4490674ae819SStefano Zampini 
4491f34684f1SStefano Zampini #undef __FUNCT__
4492f34684f1SStefano Zampini #define __FUNCT__ "PCBDDCComputePrimalNumbering"
4493f34684f1SStefano Zampini PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
4494f34684f1SStefano Zampini {
4495f34684f1SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4496f34684f1SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
4497f34684f1SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
449873be2a3aSStefano Zampini   PetscInt       i,coarse_size=0;
449973be2a3aSStefano Zampini   PetscInt       *local_primal_indices=NULL;
4500f34684f1SStefano Zampini   PetscErrorCode ierr;
4501f34684f1SStefano Zampini 
4502f34684f1SStefano Zampini   PetscFunctionBegin;
4503f34684f1SStefano Zampini   /* Compute global number of coarse dofs */
450489c96988SStefano Zampini   if (!pcbddc->primal_indices_local_idxs && pcbddc->local_primal_size) {
450589c96988SStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Local primal indices have not been created");
4506727cdba6SStefano Zampini   }
4507727cdba6SStefano 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);
4508f34684f1SStefano Zampini 
4509f34684f1SStefano Zampini   /* check numbering */
4510f34684f1SStefano Zampini   if (pcbddc->dbg_flag) {
4511f34684f1SStefano Zampini     PetscScalar coarsesum,*array;
4512b9b85e73SStefano Zampini     PetscBool set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
4513f34684f1SStefano Zampini 
4514f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4515f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4516f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
45170fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
4518f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
4519f34684f1SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
4520727cdba6SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
4521f34684f1SStefano Zampini     }
4522f34684f1SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
4523f34684f1SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
4524f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
4525f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4526f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4527f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4528f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4529f34684f1SStefano Zampini     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4530f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
4531f34684f1SStefano Zampini       if (array[i] == 1.0) {
4532b9b85e73SStefano Zampini         set_error = PETSC_TRUE;
4533f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d owned by a single process!\n",PetscGlobalRank,i);CHKERRQ(ierr);
4534f34684f1SStefano Zampini       }
4535f34684f1SStefano Zampini     }
4536b9b85e73SStefano Zampini     ierr = MPI_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4537f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4538f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
4539f34684f1SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
4540f34684f1SStefano Zampini     }
4541f34684f1SStefano Zampini     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4542f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
4543f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4544f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4545f34684f1SStefano Zampini     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
4546f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
4547b9b85e73SStefano Zampini     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
4548ca8b9ea9SStefano Zampini       PetscInt *gidxs;
4549ca8b9ea9SStefano Zampini 
4550ca8b9ea9SStefano Zampini       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
4551ca8b9ea9SStefano Zampini       ierr = ISLocalToGlobalMappingApply(matis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
4552f34684f1SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
4553f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4554f34684f1SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
4555f34684f1SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
4556*4bc2dc4bSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_primal_indices[%d]=%d (%d,%d)\n",i,local_primal_indices[i],pcbddc->primal_indices_local_idxs[i],gidxs[i]);CHKERRQ(ierr);
4557f34684f1SStefano Zampini       }
4558f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4559ca8b9ea9SStefano Zampini       ierr = PetscFree(gidxs);CHKERRQ(ierr);
4560f34684f1SStefano Zampini     }
4561f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4562302440fdSBarry Smith     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
4563f34684f1SStefano Zampini   }
45648bec7fa6SStefano Zampini   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
4565f34684f1SStefano Zampini   /* get back data */
4566f34684f1SStefano Zampini   *coarse_size_n = coarse_size;
4567f34684f1SStefano Zampini   *local_primal_indices_n = local_primal_indices;
4568674ae819SStefano Zampini   PetscFunctionReturn(0);
4569674ae819SStefano Zampini }
4570674ae819SStefano Zampini 
4571e456f2a8SStefano Zampini #undef __FUNCT__
4572e456f2a8SStefano Zampini #define __FUNCT__ "PCBDDCGlobalToLocal"
4573a7dc3881SStefano Zampini PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
4574e456f2a8SStefano Zampini {
4575e456f2a8SStefano Zampini   IS             localis_t;
4576a7dc3881SStefano Zampini   PetscInt       i,lsize,*idxs,n;
4577e456f2a8SStefano Zampini   PetscScalar    *vals;
4578e456f2a8SStefano Zampini   PetscErrorCode ierr;
4579e456f2a8SStefano Zampini 
4580e456f2a8SStefano Zampini   PetscFunctionBegin;
4581a7dc3881SStefano Zampini   /* get indices in local ordering exploiting local to global map */
4582e456f2a8SStefano Zampini   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
4583854ce69bSBarry Smith   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
4584e456f2a8SStefano Zampini   for (i=0;i<lsize;i++) vals[i] = 1.0;
4585e456f2a8SStefano Zampini   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
4586a7dc3881SStefano Zampini   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
4587a7dc3881SStefano Zampini   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
45881035eff8SStefano Zampini   if (idxs) { /* multilevel guard */
4589a7dc3881SStefano Zampini     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
45901035eff8SStefano Zampini   }
4591a7dc3881SStefano Zampini   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
4592e456f2a8SStefano Zampini   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
4593e456f2a8SStefano Zampini   ierr = PetscFree(vals);CHKERRQ(ierr);
4594a7dc3881SStefano Zampini   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
4595a7dc3881SStefano Zampini   /* now compute set in local ordering */
4596a7dc3881SStefano Zampini   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4597a7dc3881SStefano Zampini   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4598a7dc3881SStefano Zampini   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
4599a7dc3881SStefano Zampini   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
4600a7dc3881SStefano Zampini   for (i=0,lsize=0;i<n;i++) {
4601ff92baa0SMatthew G. Knepley     if (PetscRealPart(vals[i]) > 0.5) {
4602e456f2a8SStefano Zampini       lsize++;
4603e456f2a8SStefano Zampini     }
4604e456f2a8SStefano Zampini   }
4605854ce69bSBarry Smith   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
4606a7dc3881SStefano Zampini   for (i=0,lsize=0;i<n;i++) {
4607ff92baa0SMatthew G. Knepley     if (PetscRealPart(vals[i]) > 0.5) {
4608e456f2a8SStefano Zampini       idxs[lsize++] = i;
4609e456f2a8SStefano Zampini     }
4610e456f2a8SStefano Zampini   }
4611a7dc3881SStefano Zampini   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
4612a7dc3881SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
4613e456f2a8SStefano Zampini   *localis = localis_t;
4614e456f2a8SStefano Zampini   PetscFunctionReturn(0);
4615e456f2a8SStefano Zampini }
4616906d46d4SStefano Zampini 
4617906d46d4SStefano Zampini /* the next two functions will be called in KSPMatMult if a change of basis has been requested */
4618906d46d4SStefano Zampini #undef __FUNCT__
4619906d46d4SStefano Zampini #define __FUNCT__ "PCBDDCMatMult_Private"
4620906d46d4SStefano Zampini static PetscErrorCode PCBDDCMatMult_Private(Mat A, Vec x, Vec y)
4621906d46d4SStefano Zampini {
4622906d46d4SStefano Zampini   PCBDDCChange_ctx change_ctx;
4623906d46d4SStefano Zampini   PetscErrorCode   ierr;
4624906d46d4SStefano Zampini 
4625906d46d4SStefano Zampini   PetscFunctionBegin;
4626906d46d4SStefano Zampini   ierr = MatShellGetContext(A,&change_ctx);CHKERRQ(ierr);
4627906d46d4SStefano Zampini   ierr = MatMult(change_ctx->global_change,x,change_ctx->work[0]);CHKERRQ(ierr);
4628906d46d4SStefano Zampini   ierr = MatMult(change_ctx->original_mat,change_ctx->work[0],change_ctx->work[1]);CHKERRQ(ierr);
4629906d46d4SStefano Zampini   ierr = MatMultTranspose(change_ctx->global_change,change_ctx->work[1],y);CHKERRQ(ierr);
4630906d46d4SStefano Zampini   PetscFunctionReturn(0);
4631906d46d4SStefano Zampini }
4632906d46d4SStefano Zampini 
4633906d46d4SStefano Zampini #undef __FUNCT__
4634906d46d4SStefano Zampini #define __FUNCT__ "PCBDDCMatMultTranspose_Private"
4635906d46d4SStefano Zampini static PetscErrorCode PCBDDCMatMultTranspose_Private(Mat A, Vec x, Vec y)
4636906d46d4SStefano Zampini {
4637906d46d4SStefano Zampini   PCBDDCChange_ctx change_ctx;
4638906d46d4SStefano Zampini   PetscErrorCode   ierr;
4639906d46d4SStefano Zampini 
4640906d46d4SStefano Zampini   PetscFunctionBegin;
4641906d46d4SStefano Zampini   ierr = MatShellGetContext(A,&change_ctx);CHKERRQ(ierr);
4642906d46d4SStefano Zampini   ierr = MatMult(change_ctx->global_change,x,change_ctx->work[0]);CHKERRQ(ierr);
4643906d46d4SStefano Zampini   ierr = MatMultTranspose(change_ctx->original_mat,change_ctx->work[0],change_ctx->work[1]);CHKERRQ(ierr);
4644906d46d4SStefano Zampini   ierr = MatMultTranspose(change_ctx->global_change,change_ctx->work[1],y);CHKERRQ(ierr);
4645906d46d4SStefano Zampini   PetscFunctionReturn(0);
4646906d46d4SStefano Zampini }
4647b96c3477SStefano Zampini 
4648b96c3477SStefano Zampini #undef __FUNCT__
4649b96c3477SStefano Zampini #define __FUNCT__ "PCBDDCSetUpSubSchurs"
465008122e43SStefano Zampini PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
4651b96c3477SStefano Zampini {
4652b96c3477SStefano Zampini   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
4653b96c3477SStefano Zampini   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
4654b96c3477SStefano Zampini   PetscInt            *used_xadj,*used_adjncy;
4655b96c3477SStefano Zampini   PetscBool           free_used_adj;
4656b96c3477SStefano Zampini   PetscErrorCode      ierr;
4657b96c3477SStefano Zampini 
4658b96c3477SStefano Zampini   PetscFunctionBegin;
4659b96c3477SStefano Zampini   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
4660b96c3477SStefano Zampini   free_used_adj = PETSC_FALSE;
466108122e43SStefano Zampini   if (pcbddc->sub_schurs_layers == -1) {
4662b96c3477SStefano Zampini     used_xadj = NULL;
4663b96c3477SStefano Zampini     used_adjncy = NULL;
4664b96c3477SStefano Zampini   } else {
466508122e43SStefano Zampini     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
466608122e43SStefano Zampini       used_xadj = pcbddc->mat_graph->xadj;
466708122e43SStefano Zampini       used_adjncy = pcbddc->mat_graph->adjncy;
466808122e43SStefano Zampini     } else if (pcbddc->computed_rowadj) {
4669b96c3477SStefano Zampini       used_xadj = pcbddc->mat_graph->xadj;
4670b96c3477SStefano Zampini       used_adjncy = pcbddc->mat_graph->adjncy;
4671b96c3477SStefano Zampini     } else {
46722fffb893SStefano Zampini       PetscBool      flg_row=PETSC_FALSE;
4673b96c3477SStefano Zampini       const PetscInt *xadj,*adjncy;
4674b96c3477SStefano Zampini       PetscInt       nvtxs;
4675b96c3477SStefano Zampini 
46762fffb893SStefano Zampini       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
46772fffb893SStefano Zampini       if (flg_row) {
4678b96c3477SStefano Zampini         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
4679b96c3477SStefano Zampini         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
4680b96c3477SStefano Zampini         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
4681b96c3477SStefano Zampini         free_used_adj = PETSC_TRUE;
46822fffb893SStefano Zampini       } else {
46832fffb893SStefano Zampini         pcbddc->sub_schurs_layers = -1;
46842fffb893SStefano Zampini         used_xadj = NULL;
46852fffb893SStefano Zampini         used_adjncy = NULL;
46862fffb893SStefano Zampini       }
46872fffb893SStefano Zampini       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4688b96c3477SStefano Zampini     }
4689b96c3477SStefano Zampini   }
4690ac632422SStefano Zampini   ierr = PCBDDCSubSchursSetUp(sub_schurs,used_xadj,used_adjncy,pcbddc->sub_schurs_layers,pcbddc->faster_deluxe,pcbddc->adaptive_selection,pcbddc->adaptive_invert_Stildas,pcbddc->use_edges,pcbddc->use_faces);CHKERRQ(ierr);
4691b96c3477SStefano Zampini 
4692b96c3477SStefano Zampini   /* free adjacency */
4693b96c3477SStefano Zampini   if (free_used_adj) {
4694b96c3477SStefano Zampini     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
4695b96c3477SStefano Zampini   }
4696b96c3477SStefano Zampini   PetscFunctionReturn(0);
4697b96c3477SStefano Zampini }
4698b96c3477SStefano Zampini 
4699b96c3477SStefano Zampini #undef __FUNCT__
4700b96c3477SStefano Zampini #define __FUNCT__ "PCBDDCInitSubSchurs"
470108122e43SStefano Zampini PetscErrorCode PCBDDCInitSubSchurs(PC pc)
4702b96c3477SStefano Zampini {
4703b96c3477SStefano Zampini   PC_IS               *pcis=(PC_IS*)pc->data;
4704b96c3477SStefano Zampini   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
4705b96c3477SStefano Zampini   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
4706b96c3477SStefano Zampini   PCBDDCGraph         graph;
4707b96c3477SStefano Zampini   Mat                 S_j;
4708b96c3477SStefano Zampini   PetscErrorCode      ierr;
4709b96c3477SStefano Zampini 
4710b96c3477SStefano Zampini   PetscFunctionBegin;
4711b96c3477SStefano Zampini   /* attach interface graph for determining subsets */
471208122e43SStefano Zampini   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
4713b96c3477SStefano Zampini     IS verticesIS;
4714b96c3477SStefano Zampini 
4715b96c3477SStefano Zampini     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
4716b96c3477SStefano Zampini     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
4717b96c3477SStefano Zampini     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap);CHKERRQ(ierr);
4718b96c3477SStefano Zampini     ierr = PCBDDCGraphSetUp(graph,0,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticesIS);CHKERRQ(ierr);
4719b96c3477SStefano Zampini     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
4720b96c3477SStefano Zampini     ierr = ISDestroy(&verticesIS);CHKERRQ(ierr);
4721b96c3477SStefano Zampini /*
4722b96c3477SStefano Zampini     if (pcbddc->dbg_flag) {
4723b96c3477SStefano Zampini       ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
4724b96c3477SStefano Zampini     }
4725b96c3477SStefano Zampini */
4726b96c3477SStefano Zampini   } else {
4727b96c3477SStefano Zampini     graph = pcbddc->mat_graph;
4728b96c3477SStefano Zampini   }
4729b96c3477SStefano Zampini 
4730b96c3477SStefano Zampini   /* Create Schur complement matrix */
4731b96c3477SStefano Zampini   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
4732b96c3477SStefano Zampini   ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
4733b96c3477SStefano Zampini 
4734b96c3477SStefano Zampini   /* sub_schurs init */
47355a95e1ceSStefano Zampini   ierr = PCBDDCSubSchursInit(sub_schurs,pcbddc->local_mat,S_j,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap);CHKERRQ(ierr);
4736b96c3477SStefano Zampini   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
4737b96c3477SStefano Zampini   /* free graph struct */
473808122e43SStefano Zampini   if (pcbddc->sub_schurs_rebuild) {
4739b96c3477SStefano Zampini     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
4740b96c3477SStefano Zampini   }
4741b96c3477SStefano Zampini   PetscFunctionReturn(0);
4742b96c3477SStefano Zampini }
4743