xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision d5574798c8464fdb92aede3bf97f4457bb71bbdc)
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) {
1421*d5574798SStefano Zampini     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
1422964fefecSStefano Zampini     if (pcbddc->issym) {
1423964fefecSStefano Zampini       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
1424964fefecSStefano Zampini     }
1425ac78edfcSStefano Zampini     /* Matrix for Dirichlet problem is pcis->A_II */
1426964fefecSStefano Zampini     n_D = pcis->n - pcis->n_B;
1427304d26faSStefano Zampini     if (!pcbddc->ksp_D) { /* create object if not yet build */
1428304d26faSStefano Zampini       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
1429304d26faSStefano Zampini       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
1430304d26faSStefano Zampini       /* default */
1431304d26faSStefano Zampini       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
1432e604994aSStefano Zampini       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
14339577ea80SStefano Zampini       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
1434304d26faSStefano Zampini       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
14359577ea80SStefano Zampini       if (issbaij) {
14369577ea80SStefano Zampini         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
14379577ea80SStefano Zampini       } else {
1438304d26faSStefano Zampini         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
14399577ea80SStefano Zampini       }
1440304d26faSStefano Zampini       /* Allow user's customization */
1441304d26faSStefano Zampini       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
1442304d26faSStefano Zampini       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1443304d26faSStefano Zampini     }
1444d1e9a80fSBarry Smith     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
1445*d5574798SStefano Zampini     if (sub_schurs->interior_solver) {
1446*d5574798SStefano Zampini       ierr = KSPSetPC(pcbddc->ksp_D,sub_schurs->interior_solver);CHKERRQ(ierr);
1447*d5574798SStefano Zampini     }
1448304d26faSStefano Zampini     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1449304d26faSStefano Zampini     if (!n_D) {
1450304d26faSStefano Zampini       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
1451304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1452304d26faSStefano Zampini     }
1453304d26faSStefano Zampini     /* Set Up KSP for Dirichlet problem of BDDC */
1454304d26faSStefano Zampini     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
1455304d26faSStefano Zampini     /* set ksp_D into pcis data */
1456304d26faSStefano Zampini     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
1457304d26faSStefano Zampini     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
1458304d26faSStefano Zampini     pcis->ksp_D = pcbddc->ksp_D;
1459684f6988SStefano Zampini   }
1460304d26faSStefano Zampini 
1461304d26faSStefano Zampini   /* NEUMANN PROBLEM */
1462684f6988SStefano Zampini   A_RR = 0;
1463684f6988SStefano Zampini   if (neumann) {
1464f4ddd8eeSStefano Zampini     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
14658ce42a96SStefano Zampini     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
1466f4ddd8eeSStefano Zampini     if (pcbddc->ksp_R) { /* already created ksp */
1467f4ddd8eeSStefano Zampini       PetscInt nn_R;
146881d9aea3SBarry Smith       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
1469f4ddd8eeSStefano Zampini       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
1470f4ddd8eeSStefano Zampini       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
1471f4ddd8eeSStefano Zampini       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
1472f4ddd8eeSStefano Zampini         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
1473f4ddd8eeSStefano Zampini         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1474f4ddd8eeSStefano Zampini         reuse = MAT_INITIAL_MATRIX;
1475f4ddd8eeSStefano Zampini       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
1476727cdba6SStefano Zampini         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
1477f4ddd8eeSStefano Zampini           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1478f4ddd8eeSStefano Zampini           reuse = MAT_INITIAL_MATRIX;
1479f4ddd8eeSStefano Zampini         } else { /* safe to reuse the matrix */
1480f4ddd8eeSStefano Zampini           reuse = MAT_REUSE_MATRIX;
1481f4ddd8eeSStefano Zampini         }
1482f4ddd8eeSStefano Zampini       }
1483f4ddd8eeSStefano Zampini       /* last check */
1484d1e9a80fSBarry Smith       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
1485f4ddd8eeSStefano Zampini         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1486f4ddd8eeSStefano Zampini         reuse = MAT_INITIAL_MATRIX;
1487f4ddd8eeSStefano Zampini       }
1488f4ddd8eeSStefano Zampini     } else { /* first time, so we need to create the matrix */
1489f4ddd8eeSStefano Zampini       reuse = MAT_INITIAL_MATRIX;
1490f4ddd8eeSStefano Zampini     }
1491f4ddd8eeSStefano Zampini     /* extract A_RR */
1492af732b37SStefano Zampini     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
1493af732b37SStefano Zampini     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
14943a50541eSStefano Zampini     if (ibs != mbs) {
1495af732b37SStefano Zampini       Mat newmat;
1496af732b37SStefano Zampini       ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
1497f4ddd8eeSStefano Zampini       ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
1498af732b37SStefano Zampini       ierr = MatDestroy(&newmat);CHKERRQ(ierr);
1499af732b37SStefano Zampini     } else {
1500f4ddd8eeSStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
1501af732b37SStefano Zampini     }
1502964fefecSStefano Zampini     if (pcbddc->issym) {
1503964fefecSStefano Zampini       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
1504964fefecSStefano Zampini     }
1505f4ddd8eeSStefano Zampini     if (!pcbddc->ksp_R) { /* create object if not present */
1506304d26faSStefano Zampini       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
1507304d26faSStefano Zampini       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
1508304d26faSStefano Zampini       /* default */
1509304d26faSStefano Zampini       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
1510e604994aSStefano Zampini       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
1511304d26faSStefano Zampini       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
15129577ea80SStefano Zampini       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
15139577ea80SStefano Zampini       if (issbaij) {
15149577ea80SStefano Zampini         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
15159577ea80SStefano Zampini       } else {
1516304d26faSStefano Zampini         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
15179577ea80SStefano Zampini       }
1518304d26faSStefano Zampini       /* Allow user's customization */
1519304d26faSStefano Zampini       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
1520304d26faSStefano Zampini       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1521304d26faSStefano Zampini     }
1522d1e9a80fSBarry Smith     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
1523304d26faSStefano Zampini     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1524304d26faSStefano Zampini     if (!n_R) {
1525304d26faSStefano Zampini       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
1526304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1527304d26faSStefano Zampini     }
1528304d26faSStefano Zampini     /* Set Up KSP for Neumann problem of BDDC */
1529304d26faSStefano Zampini     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
1530684f6988SStefano Zampini   }
1531304d26faSStefano Zampini 
1532304d26faSStefano Zampini   /* check Dirichlet and Neumann solvers and adapt them if a nullspace correction is needed */
15330fccc4e9SStefano Zampini   if (pcbddc->NullSpace || pcbddc->dbg_flag) {
1534684f6988SStefano Zampini     if (pcbddc->dbg_flag) {
1535684f6988SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1536684f6988SStefano Zampini       ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1537684f6988SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1538684f6988SStefano Zampini     }
1539684f6988SStefano Zampini     if (dirichlet) { /* Dirichlet */
15400fccc4e9SStefano Zampini       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
15410fccc4e9SStefano Zampini       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
15420fccc4e9SStefano Zampini       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
15430fccc4e9SStefano Zampini       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
15440fccc4e9SStefano Zampini       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
1545304d26faSStefano Zampini       /* need to be adapted? */
1546b8ffe317SStefano Zampini       use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1547b8ffe317SStefano Zampini       ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1548b8ffe317SStefano Zampini       ierr = PCBDDCSetUseExactDirichlet(pc,use_exact_reduced);CHKERRQ(ierr);
1549304d26faSStefano Zampini       /* print info */
1550304d26faSStefano Zampini       if (pcbddc->dbg_flag) {
1551e604994aSStefano 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);
1552304d26faSStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1553304d26faSStefano Zampini       }
1554b8ffe317SStefano Zampini       if (pcbddc->NullSpace && !use_exact_reduced && !pcbddc->switch_static) {
15558ce42a96SStefano Zampini         ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcis->is_I_local);CHKERRQ(ierr);
1556304d26faSStefano Zampini       }
1557684f6988SStefano Zampini     }
1558684f6988SStefano Zampini     if (neumann) { /* Neumann */
15590fccc4e9SStefano Zampini       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
15600fccc4e9SStefano Zampini       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
15610fccc4e9SStefano Zampini       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
15620fccc4e9SStefano Zampini       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
15630fccc4e9SStefano Zampini       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
1564304d26faSStefano Zampini       /* need to be adapted? */
1565b8ffe317SStefano Zampini       use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1566b8ffe317SStefano Zampini       ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1567304d26faSStefano Zampini       /* print info */
1568304d26faSStefano Zampini       if (pcbddc->dbg_flag) {
1569e604994aSStefano 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);
1570304d26faSStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1571304d26faSStefano Zampini       }
1572b8ffe317SStefano Zampini       if (pcbddc->NullSpace && !use_exact_reduced) { /* is it the right logic? */
15738ce42a96SStefano Zampini         ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcbddc->is_R_local);CHKERRQ(ierr);
1574304d26faSStefano Zampini       }
15750fccc4e9SStefano Zampini     }
1576684f6988SStefano Zampini   }
1577304d26faSStefano Zampini   /* free Neumann problem's matrix */
1578304d26faSStefano Zampini   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1579304d26faSStefano Zampini   PetscFunctionReturn(0);
1580304d26faSStefano Zampini }
1581304d26faSStefano Zampini 
1582304d26faSStefano Zampini #undef __FUNCT__
1583ba15a52eSStefano Zampini #define __FUNCT__ "PCBDDCSolveSubstructureCorrection"
158420c7b377SStefano Zampini static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec rhs, Vec sol, Vec work, PetscBool applytranspose)
1585674ae819SStefano Zampini {
1586674ae819SStefano Zampini   PetscErrorCode ierr;
1587674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1588674ae819SStefano Zampini 
1589674ae819SStefano Zampini   PetscFunctionBegin;
159020c7b377SStefano Zampini   if (applytranspose) {
1591674ae819SStefano Zampini     if (pcbddc->local_auxmat1) {
159220c7b377SStefano Zampini       ierr = MatMultTranspose(pcbddc->local_auxmat2,rhs,work);CHKERRQ(ierr);
159320c7b377SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,work,rhs,rhs);CHKERRQ(ierr);
159420c7b377SStefano Zampini     }
159520c7b377SStefano Zampini     ierr = KSPSolveTranspose(pcbddc->ksp_R,rhs,sol);CHKERRQ(ierr);
159620c7b377SStefano Zampini   } else {
159720c7b377SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,rhs,sol);CHKERRQ(ierr);
159820c7b377SStefano Zampini     if (pcbddc->local_auxmat1) {
159920c7b377SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,sol,work);CHKERRQ(ierr);
160020c7b377SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,work,sol,sol);CHKERRQ(ierr);
160120c7b377SStefano Zampini     }
1602674ae819SStefano Zampini   }
1603674ae819SStefano Zampini   PetscFunctionReturn(0);
1604674ae819SStefano Zampini }
1605674ae819SStefano Zampini 
1606dc359a40SStefano Zampini /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
1607674ae819SStefano Zampini #undef __FUNCT__
1608674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
1609dc359a40SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
1610674ae819SStefano Zampini {
1611674ae819SStefano Zampini   PetscErrorCode ierr;
1612674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
1613674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
1614674ae819SStefano Zampini   const PetscScalar zero = 0.0;
1615674ae819SStefano Zampini 
1616674ae819SStefano Zampini   PetscFunctionBegin;
1617dc359a40SStefano Zampini   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
1618dc359a40SStefano Zampini   if (applytranspose) {
1619674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
16208eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
1621dc359a40SStefano Zampini   } else {
1622674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
1623674ae819SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
162415aaf578SStefano Zampini   }
162512edc857SStefano Zampini   /* start communications from local primal nodes to rhs of coarse solver */
162612edc857SStefano Zampini   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
162712edc857SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
162812edc857SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
162912edc857SStefano Zampini 
16309f00e9b4SStefano Zampini   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
163112edc857SStefano Zampini   /* TODO remove null space when doing multilevel */
163212edc857SStefano Zampini   if (pcbddc->coarse_ksp) {
1633964fefecSStefano Zampini     Vec rhs,sol;
1634964fefecSStefano Zampini 
1635964fefecSStefano Zampini     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
1636964fefecSStefano Zampini     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
163712edc857SStefano Zampini     if (applytranspose) {
1638964fefecSStefano Zampini       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
163912edc857SStefano Zampini     } else {
1640964fefecSStefano Zampini       ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
164112edc857SStefano Zampini     }
164212edc857SStefano Zampini   }
1643674ae819SStefano Zampini 
1644674ae819SStefano Zampini   /* Local solution on R nodes */
16459f00e9b4SStefano Zampini   if (pcis->n) {
1646674ae819SStefano Zampini     ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1647674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1648674ae819SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
16498eeda7d8SStefano Zampini     if (pcbddc->switch_static) {
1650674ae819SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1651674ae819SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1652674ae819SStefano Zampini     }
165320c7b377SStefano Zampini     ierr = PCBDDCSolveSubstructureCorrection(pc,pcbddc->vec1_R,pcbddc->vec2_R,pcbddc->vec1_C,applytranspose);CHKERRQ(ierr);
1654674ae819SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1655674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1656674ae819SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
16578eeda7d8SStefano Zampini     if (pcbddc->switch_static) {
1658674ae819SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1659674ae819SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1660674ae819SStefano Zampini     }
16619f00e9b4SStefano Zampini   }
1662674ae819SStefano Zampini 
16639f00e9b4SStefano Zampini   /* communications from coarse sol to local primal nodes */
16649f00e9b4SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
166512edc857SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1666674ae819SStefano Zampini 
1667674ae819SStefano Zampini   /* Sum contributions from two levels */
1668dc359a40SStefano Zampini   if (applytranspose) {
1669dc359a40SStefano Zampini     ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
1670dc359a40SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1671dc359a40SStefano Zampini   } else {
1672674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
16738eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1674dc359a40SStefano Zampini   }
1675674ae819SStefano Zampini   PetscFunctionReturn(0);
1676674ae819SStefano Zampini }
1677674ae819SStefano Zampini 
1678674ae819SStefano Zampini #undef __FUNCT__
1679674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
168012edc857SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
1681674ae819SStefano Zampini {
1682674ae819SStefano Zampini   PetscErrorCode ierr;
1683674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
168458da7f69SStefano Zampini   PetscScalar    *array;
168512edc857SStefano Zampini   Vec            from,to;
1686674ae819SStefano Zampini 
1687674ae819SStefano Zampini   PetscFunctionBegin;
168812edc857SStefano Zampini   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
168912edc857SStefano Zampini     from = pcbddc->coarse_vec;
169012edc857SStefano Zampini     to = pcbddc->vec1_P;
169112edc857SStefano Zampini     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
169212edc857SStefano Zampini       Vec tvec;
169358da7f69SStefano Zampini 
169458da7f69SStefano Zampini       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
169558da7f69SStefano Zampini       ierr = VecResetArray(tvec);CHKERRQ(ierr);
169612edc857SStefano Zampini       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
169758da7f69SStefano Zampini       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
169858da7f69SStefano Zampini       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
169958da7f69SStefano Zampini       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
170012edc857SStefano Zampini     }
170112edc857SStefano Zampini   } else { /* from local to global -> put data in coarse right hand side */
170212edc857SStefano Zampini     from = pcbddc->vec1_P;
170312edc857SStefano Zampini     to = pcbddc->coarse_vec;
170412edc857SStefano Zampini   }
170512edc857SStefano Zampini   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
1706674ae819SStefano Zampini   PetscFunctionReturn(0);
1707674ae819SStefano Zampini }
1708674ae819SStefano Zampini 
1709674ae819SStefano Zampini #undef __FUNCT__
1710674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
171112edc857SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
1712674ae819SStefano Zampini {
1713674ae819SStefano Zampini   PetscErrorCode ierr;
1714674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
171558da7f69SStefano Zampini   PetscScalar    *array;
171612edc857SStefano Zampini   Vec            from,to;
1717674ae819SStefano Zampini 
1718674ae819SStefano Zampini   PetscFunctionBegin;
171912edc857SStefano Zampini   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
172012edc857SStefano Zampini     from = pcbddc->coarse_vec;
172112edc857SStefano Zampini     to = pcbddc->vec1_P;
172212edc857SStefano Zampini   } else { /* from local to global -> put data in coarse right hand side */
172312edc857SStefano Zampini     from = pcbddc->vec1_P;
172412edc857SStefano Zampini     to = pcbddc->coarse_vec;
172512edc857SStefano Zampini   }
172612edc857SStefano Zampini   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
172712edc857SStefano Zampini   if (smode == SCATTER_FORWARD) {
172812edc857SStefano Zampini     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
172912edc857SStefano Zampini       Vec tvec;
173058da7f69SStefano Zampini 
173112edc857SStefano Zampini       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
173258da7f69SStefano Zampini       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
173358da7f69SStefano Zampini       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
173458da7f69SStefano Zampini       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
173558da7f69SStefano Zampini     }
173658da7f69SStefano Zampini   } else {
173758da7f69SStefano Zampini     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
173858da7f69SStefano Zampini      ierr = VecResetArray(from);CHKERRQ(ierr);
173912edc857SStefano Zampini     }
174012edc857SStefano Zampini   }
1741674ae819SStefano Zampini   PetscFunctionReturn(0);
1742674ae819SStefano Zampini }
1743674ae819SStefano Zampini 
1744984c4197SStefano Zampini /* uncomment for testing purposes */
1745984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */
1746674ae819SStefano Zampini #undef __FUNCT__
1747674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
1748674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
1749674ae819SStefano Zampini {
1750674ae819SStefano Zampini   PetscErrorCode    ierr;
1751674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
1752674ae819SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1753674ae819SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
1754984c4197SStefano Zampini   /* one and zero */
1755984c4197SStefano Zampini   PetscScalar       one=1.0,zero=0.0;
1756984c4197SStefano Zampini   /* space to store constraints and their local indices */
1757984c4197SStefano Zampini   PetscScalar       *temp_quadrature_constraint;
1758984c4197SStefano Zampini   PetscInt          *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B;
1759984c4197SStefano Zampini   /* iterators */
1760984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
1761984c4197SStefano Zampini   /* BLAS integers */
1762e310c8b4SStefano Zampini   PetscBLASInt      lwork,lierr;
1763e310c8b4SStefano Zampini   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
1764c4303822SStefano Zampini   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
1765727cdba6SStefano Zampini   /* reuse */
1766727cdba6SStefano Zampini   PetscInt          olocal_primal_size;
1767727cdba6SStefano Zampini   PetscInt          *oprimal_indices_local_idxs;
1768984c4197SStefano Zampini   /* change of basis */
1769984c4197SStefano Zampini   PetscInt          *aux_primal_numbering,*aux_primal_minloc,*global_indices;
1770a717540cSStefano Zampini   PetscBool         boolforchange,qr_needed;
1771a717540cSStefano Zampini   PetscBT           touched,change_basis,qr_needed_idx;
1772984c4197SStefano Zampini   /* auxiliary stuff */
177339e2fb2aSStefano Zampini   PetscInt          *nnz,*is_indices,*aux_primal_numbering_B;
1774a58a30b4SStefano Zampini   PetscInt          ncc,*gidxs=NULL,*permutation=NULL,*temp_indices_to_constraint_work=NULL;
1775a58a30b4SStefano Zampini   PetscScalar       *temp_quadrature_constraint_work=NULL;
1776984c4197SStefano Zampini   /* some quantities */
177745a1bb75SStefano Zampini   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
1778a58a30b4SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
1779984c4197SStefano Zampini 
1780674ae819SStefano Zampini   PetscFunctionBegin;
17818e61c736SStefano Zampini   /* Destroy Mat objects computed previously */
17828e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
17838e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1784cf5a6209SStefano Zampini 
1785cf5a6209SStefano Zampini   /* print some info */
1786cf5a6209SStefano Zampini   if (pcbddc->dbg_flag) {
1787cf5a6209SStefano Zampini     IS       vertices;
1788cf5a6209SStefano Zampini     PetscInt nv,nedges,nfaces;
1789cf5a6209SStefano Zampini     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
1790cf5a6209SStefano Zampini     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
1791cf5a6209SStefano Zampini     ierr = ISDestroy(&vertices);CHKERRQ(ierr);
1792cf5a6209SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1793cf5a6209SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1794cf5a6209SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
1795fd14bc51SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
1796fd14bc51SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
1797cf5a6209SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1798cf5a6209SStefano Zampini   }
1799cf5a6209SStefano Zampini 
1800cf5a6209SStefano Zampini   if (!pcbddc->adaptive_selection) {
1801cf5a6209SStefano Zampini     IS           ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
1802cf5a6209SStefano Zampini     MatNullSpace nearnullsp;
1803cf5a6209SStefano Zampini     const Vec    *nearnullvecs;
1804cf5a6209SStefano Zampini     Vec          *localnearnullsp;
1805cf5a6209SStefano Zampini     PetscScalar  *array;
1806cf5a6209SStefano Zampini     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
1807cf5a6209SStefano Zampini     PetscBool    nnsp_has_cnst;
1808cf5a6209SStefano Zampini     /* LAPACK working arrays for SVD or POD */
1809cf5a6209SStefano Zampini     PetscBool    skip_lapack;
1810cf5a6209SStefano Zampini     PetscScalar  *work;
1811cf5a6209SStefano Zampini     PetscReal    *singular_vals;
1812cf5a6209SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1813cf5a6209SStefano Zampini     PetscReal    *rwork;
1814cf5a6209SStefano Zampini #endif
1815cf5a6209SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1816cf5a6209SStefano Zampini     PetscScalar  *temp_basis,*correlation_mat;
1817cf5a6209SStefano Zampini #else
1818964fefecSStefano Zampini     PetscBLASInt dummy_int=1;
1819964fefecSStefano Zampini     PetscScalar  dummy_scalar=1.;
1820cf5a6209SStefano Zampini #endif
1821cf5a6209SStefano Zampini 
1822674ae819SStefano Zampini     /* Get index sets for faces, edges and vertices from graph */
1823d06fc5fdSStefano Zampini     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
1824d06fc5fdSStefano Zampini     /* free unneeded index sets */
1825d06fc5fdSStefano Zampini     if (!pcbddc->use_vertices) {
1826d06fc5fdSStefano Zampini       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
1827674ae819SStefano Zampini     }
1828d06fc5fdSStefano Zampini     if (!pcbddc->use_edges) {
1829d06fc5fdSStefano Zampini       for (i=0;i<n_ISForEdges;i++) {
1830d06fc5fdSStefano Zampini         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1831d06fc5fdSStefano Zampini       }
1832d06fc5fdSStefano Zampini       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1833d06fc5fdSStefano Zampini       n_ISForEdges = 0;
1834d06fc5fdSStefano Zampini     }
1835d06fc5fdSStefano Zampini     if (!pcbddc->use_faces) {
1836d06fc5fdSStefano Zampini       for (i=0;i<n_ISForFaces;i++) {
1837d06fc5fdSStefano Zampini         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1838d06fc5fdSStefano Zampini       }
1839d06fc5fdSStefano Zampini       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1840d06fc5fdSStefano Zampini       n_ISForFaces = 0;
1841d06fc5fdSStefano Zampini     }
1842d06fc5fdSStefano Zampini     /* HACKS (the following two blocks of code) */
1843b9b85e73SStefano Zampini     if (!ISForVertices && pcbddc->NullSpace && !pcbddc->user_ChangeOfBasisMatrix) {
1844b8ffe317SStefano Zampini       pcbddc->use_change_of_basis = PETSC_TRUE;
1845d06fc5fdSStefano Zampini       if (!ISForEdges) {
1846d06fc5fdSStefano Zampini         pcbddc->use_change_on_faces = PETSC_TRUE;
1847d06fc5fdSStefano Zampini       }
1848b8ffe317SStefano Zampini     }
184998a51de6SStefano Zampini     if (pcbddc->NullSpace) {
185098a51de6SStefano Zampini       /* use_change_of_basis should be consistent among processors */
1851d06fc5fdSStefano Zampini       PetscBool tbool[2],gbool[2];
1852d06fc5fdSStefano Zampini       tbool[0] = pcbddc->use_change_of_basis;
1853d06fc5fdSStefano Zampini       tbool[1] = pcbddc->use_change_on_faces;
1854d06fc5fdSStefano Zampini       ierr = MPI_Allreduce(tbool,gbool,2,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1855d06fc5fdSStefano Zampini       pcbddc->use_change_of_basis = gbool[0];
1856d06fc5fdSStefano Zampini       pcbddc->use_change_on_faces = gbool[1];
185798a51de6SStefano Zampini     }
185808122e43SStefano Zampini 
1859674ae819SStefano Zampini     /* check if near null space is attached to global mat */
1860674ae819SStefano Zampini     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
1861674ae819SStefano Zampini     if (nearnullsp) {
1862674ae819SStefano Zampini       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
1863f4ddd8eeSStefano Zampini       /* remove any stored info */
1864f4ddd8eeSStefano Zampini       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
1865f4ddd8eeSStefano Zampini       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1866f4ddd8eeSStefano Zampini       /* store information for BDDC solver reuse */
1867f4ddd8eeSStefano Zampini       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
1868f4ddd8eeSStefano Zampini       pcbddc->onearnullspace = nearnullsp;
1869473ba861SJed Brown       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1870f4ddd8eeSStefano Zampini       for (i=0;i<nnsp_size;i++) {
1871f4ddd8eeSStefano Zampini         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
1872f4ddd8eeSStefano Zampini       }
1873984c4197SStefano Zampini     } else { /* if near null space is not provided BDDC uses constants by default */
1874984c4197SStefano Zampini       nnsp_size = 0;
1875674ae819SStefano Zampini       nnsp_has_cnst = PETSC_TRUE;
1876674ae819SStefano Zampini     }
1877984c4197SStefano Zampini     /* get max number of constraints on a single cc */
1878984c4197SStefano Zampini     max_constraints = nnsp_size;
1879984c4197SStefano Zampini     if (nnsp_has_cnst) max_constraints++;
1880984c4197SStefano Zampini 
1881674ae819SStefano Zampini     /*
1882674ae819SStefano Zampini          Evaluate maximum storage size needed by the procedure
1883674ae819SStefano Zampini          - temp_indices will contain start index of each constraint stored as follows
1884911cabfeSStefano 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
1885911cabfeSStefano 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
1886911cabfeSStefano Zampini          - temp_quadrature_constraint  [temp_indices[i],...,temp_indices[i+1]-1] will contain the scalars representing the constraint itself
1887674ae819SStefano Zampini                                                                                                                                                            */
1888674ae819SStefano Zampini     total_counts = n_ISForFaces+n_ISForEdges;
1889984c4197SStefano Zampini     total_counts *= max_constraints;
1890674ae819SStefano Zampini     n_vertices = 0;
1891674ae819SStefano Zampini     if (ISForVertices) {
1892674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
1893674ae819SStefano Zampini     }
1894674ae819SStefano Zampini     total_counts += n_vertices;
1895854ce69bSBarry Smith     ierr = PetscMalloc1(total_counts+1,&temp_indices);CHKERRQ(ierr);
18964641a718SStefano Zampini     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
1897674ae819SStefano Zampini     total_counts = 0;
1898674ae819SStefano Zampini     max_size_of_constraint = 0;
1899674ae819SStefano Zampini     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1900674ae819SStefano Zampini       if (i<n_ISForEdges) {
1901674ae819SStefano Zampini         used_IS = &ISForEdges[i];
1902674ae819SStefano Zampini       } else {
1903674ae819SStefano Zampini         used_IS = &ISForFaces[i-n_ISForEdges];
1904674ae819SStefano Zampini       }
1905674ae819SStefano Zampini       ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
1906674ae819SStefano Zampini       total_counts += j;
1907674ae819SStefano Zampini       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
1908674ae819SStefano Zampini     }
1909984c4197SStefano Zampini     total_counts *= max_constraints;
1910674ae819SStefano Zampini     total_counts += n_vertices;
1911906d46d4SStefano Zampini     ierr = PetscMalloc3(total_counts,&temp_quadrature_constraint,total_counts,&temp_indices_to_constraint,total_counts,&temp_indices_to_constraint_B);CHKERRQ(ierr);
1912984c4197SStefano Zampini     /* get local part of global near null space vectors */
1913785e854fSJed Brown     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
1914984c4197SStefano Zampini     for (k=0;k<nnsp_size;k++) {
1915984c4197SStefano Zampini       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
1916984c4197SStefano Zampini       ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1917984c4197SStefano Zampini       ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1918984c4197SStefano Zampini     }
1919674ae819SStefano Zampini 
1920242a89d7SStefano Zampini     /* whether or not to skip lapack calls */
1921242a89d7SStefano Zampini     skip_lapack = PETSC_TRUE;
1922a773dcb8SStefano Zampini     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
1923242a89d7SStefano Zampini 
19248f1c130eSStefano Zampini     /* allocate some auxiliary stuff */
19258f1c130eSStefano Zampini     if (!skip_lapack || pcbddc->use_qr_single) {
19268f1c130eSStefano 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);
1927f9208b2eSJed Brown     } else {
1928f9208b2eSJed Brown       gidxs = NULL;
1929f9208b2eSJed Brown       permutation = NULL;
1930f9208b2eSJed Brown       temp_indices_to_constraint_work = NULL;
1931f9208b2eSJed Brown       temp_quadrature_constraint_work = NULL;
19328f1c130eSStefano Zampini     }
19338f1c130eSStefano Zampini 
1934984c4197SStefano Zampini     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
1935a773dcb8SStefano Zampini     if (!skip_lapack) {
1936674ae819SStefano Zampini       PetscScalar temp_work;
1937911cabfeSStefano Zampini 
1938674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1939984c4197SStefano Zampini       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
1940785e854fSJed Brown       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
1941785e854fSJed Brown       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
1942785e854fSJed Brown       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
1943674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1944785e854fSJed Brown       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
1945674ae819SStefano Zampini #endif
1946674ae819SStefano Zampini       /* now we evaluate the optimal workspace using query with lwork=-1 */
1947c8244a33SStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
1948c8244a33SStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
1949674ae819SStefano Zampini       lwork = -1;
1950674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1951674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1952c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
1953674ae819SStefano Zampini #else
1954c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
1955674ae819SStefano Zampini #endif
1956674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1957984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
1958674ae819SStefano Zampini #else /* on missing GESVD */
1959674ae819SStefano Zampini       /* SVD */
1960674ae819SStefano Zampini       PetscInt max_n,min_n;
1961674ae819SStefano Zampini       max_n = max_size_of_constraint;
1962984c4197SStefano Zampini       min_n = max_constraints;
1963984c4197SStefano Zampini       if (max_size_of_constraint < max_constraints) {
1964674ae819SStefano Zampini         min_n = max_size_of_constraint;
1965984c4197SStefano Zampini         max_n = max_constraints;
1966674ae819SStefano Zampini       }
1967785e854fSJed Brown       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
1968674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1969785e854fSJed Brown       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
1970674ae819SStefano Zampini #endif
1971674ae819SStefano Zampini       /* now we evaluate the optimal workspace using query with lwork=-1 */
1972674ae819SStefano Zampini       lwork = -1;
1973e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
1974e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
1975b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
1976674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1977674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1978cf5a6209SStefano Zampini       PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,&temp_quadrature_constraint[0],&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,&lierr));
1979674ae819SStefano Zampini #else
1980cf5a6209SStefano 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));
1981674ae819SStefano Zampini #endif
1982674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1983984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
1984984c4197SStefano Zampini #endif /* on missing GESVD */
1985674ae819SStefano Zampini       /* Allocate optimal workspace */
1986674ae819SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
1987854ce69bSBarry Smith       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
1988674ae819SStefano Zampini     }
1989674ae819SStefano Zampini     /* Now we can loop on constraining sets */
1990674ae819SStefano Zampini     total_counts = 0;
1991674ae819SStefano Zampini     temp_indices[0] = 0;
1992674ae819SStefano Zampini     /* vertices */
1993674ae819SStefano Zampini     if (ISForVertices) {
1994674ae819SStefano Zampini       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1995674ae819SStefano Zampini       if (nnsp_has_cnst) { /* consider all vertices */
199639e2fb2aSStefano Zampini         ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
1997674ae819SStefano Zampini         for (i=0;i<n_vertices;i++) {
1998674ae819SStefano Zampini           temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1999674ae819SStefano Zampini           temp_indices[total_counts+1]=temp_indices[total_counts]+1;
2000674ae819SStefano Zampini           total_counts++;
2001674ae819SStefano Zampini         }
2002674ae819SStefano Zampini       } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
2003984c4197SStefano Zampini         PetscBool used_vertex;
2004674ae819SStefano Zampini         for (i=0;i<n_vertices;i++) {
2005674ae819SStefano Zampini           used_vertex = PETSC_FALSE;
2006674ae819SStefano Zampini           k = 0;
2007674ae819SStefano Zampini           while (!used_vertex && k<nnsp_size) {
2008984c4197SStefano Zampini             ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
2009984c4197SStefano Zampini             if (PetscAbsScalar(array[is_indices[i]])>0.0) {
2010674ae819SStefano Zampini               temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
2011674ae819SStefano Zampini               temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
2012674ae819SStefano Zampini               temp_indices[total_counts+1]=temp_indices[total_counts]+1;
2013674ae819SStefano Zampini               total_counts++;
2014674ae819SStefano Zampini               used_vertex = PETSC_TRUE;
2015674ae819SStefano Zampini             }
2016984c4197SStefano Zampini             ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
2017674ae819SStefano Zampini             k++;
2018674ae819SStefano Zampini           }
2019674ae819SStefano Zampini         }
2020674ae819SStefano Zampini       }
2021674ae819SStefano Zampini       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2022674ae819SStefano Zampini       n_vertices = total_counts;
2023674ae819SStefano Zampini     }
2024984c4197SStefano Zampini 
2025674ae819SStefano Zampini     /* edges and faces */
2026911cabfeSStefano Zampini     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
2027911cabfeSStefano Zampini       if (ncc<n_ISForEdges) {
2028911cabfeSStefano Zampini         used_IS = &ISForEdges[ncc];
2029984c4197SStefano Zampini         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
2030674ae819SStefano Zampini       } else {
2031911cabfeSStefano Zampini         used_IS = &ISForFaces[ncc-n_ISForEdges];
2032984c4197SStefano Zampini         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
2033674ae819SStefano Zampini       }
2034674ae819SStefano Zampini       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
2035674ae819SStefano Zampini       temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
2036674ae819SStefano Zampini       ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
2037674ae819SStefano Zampini       ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2038984c4197SStefano Zampini       /* change of basis should not be performed on local periodic nodes */
2039984c4197SStefano Zampini       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
2040674ae819SStefano Zampini       if (nnsp_has_cnst) {
20415b08dc53SStefano Zampini         PetscScalar quad_value;
2042674ae819SStefano Zampini         temp_constraints++;
2043a773dcb8SStefano Zampini         if (!pcbddc->use_nnsp_true) {
2044674ae819SStefano Zampini           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
2045a773dcb8SStefano Zampini         } else {
2046a773dcb8SStefano Zampini           quad_value = 1.0;
2047a773dcb8SStefano Zampini         }
204839e2fb2aSStefano Zampini         ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
2049674ae819SStefano Zampini         for (j=0;j<size_of_constraint;j++) {
2050674ae819SStefano Zampini           temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
2051674ae819SStefano Zampini         }
205208122e43SStefano Zampini         /* sort by global ordering if using lapack subroutines (not needed!) */
20538f1c130eSStefano Zampini         if (!skip_lapack || pcbddc->use_qr_single) {
2054911cabfeSStefano Zampini           ierr = ISLocalToGlobalMappingApply(matis->mapping,size_of_constraint,temp_indices_to_constraint+temp_indices[total_counts],gidxs);CHKERRQ(ierr);
2055911cabfeSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
2056911cabfeSStefano Zampini             permutation[j]=j;
2057911cabfeSStefano Zampini           }
2058911cabfeSStefano Zampini           ierr = PetscSortIntWithPermutation(size_of_constraint,gidxs,permutation);CHKERRQ(ierr);
2059911cabfeSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
206008122e43SStefano Zampini             if (permutation[j]!=j) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"This should not happen");
206108122e43SStefano Zampini           }
206208122e43SStefano Zampini           for (j=0;j<size_of_constraint;j++) {
2063911cabfeSStefano Zampini             temp_indices_to_constraint_work[j] = temp_indices_to_constraint[temp_indices[total_counts]+permutation[j]];
2064911cabfeSStefano Zampini             temp_quadrature_constraint_work[j] = temp_quadrature_constraint[temp_indices[total_counts]+permutation[j]];
2065911cabfeSStefano Zampini           }
2066911cabfeSStefano Zampini           ierr = PetscMemcpy(temp_indices_to_constraint+temp_indices[total_counts],temp_indices_to_constraint_work,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
2067911cabfeSStefano Zampini           ierr = PetscMemcpy(temp_quadrature_constraint+temp_indices[total_counts],temp_quadrature_constraint_work,size_of_constraint*sizeof(PetscScalar));CHKERRQ(ierr);
2068911cabfeSStefano Zampini         }
2069674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
2070674ae819SStefano Zampini         total_counts++;
2071674ae819SStefano Zampini       }
2072674ae819SStefano Zampini       for (k=0;k<nnsp_size;k++) {
2073984c4197SStefano Zampini         PetscReal real_value;
2074984c4197SStefano Zampini         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
207539e2fb2aSStefano Zampini         ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
2076674ae819SStefano Zampini         for (j=0;j<size_of_constraint;j++) {
2077984c4197SStefano Zampini           temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
2078674ae819SStefano Zampini         }
2079984c4197SStefano Zampini         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
2080984c4197SStefano Zampini         /* check if array is null on the connected component */
2081e310c8b4SStefano Zampini         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2082e310c8b4SStefano Zampini         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one));
20835b08dc53SStefano Zampini         if (real_value > 0.0) { /* keep indices and values */
2084911cabfeSStefano Zampini           /* sort by global ordering if using lapack subroutines */
20858f1c130eSStefano Zampini           if (!skip_lapack || pcbddc->use_qr_single) {
2086911cabfeSStefano Zampini             ierr = ISLocalToGlobalMappingApply(matis->mapping,size_of_constraint,temp_indices_to_constraint+temp_indices[total_counts],gidxs);CHKERRQ(ierr);
2087911cabfeSStefano Zampini             for (j=0;j<size_of_constraint;j++) {
2088911cabfeSStefano Zampini               permutation[j]=j;
2089911cabfeSStefano Zampini             }
2090911cabfeSStefano Zampini             ierr = PetscSortIntWithPermutation(size_of_constraint,gidxs,permutation);CHKERRQ(ierr);
2091911cabfeSStefano Zampini             for (j=0;j<size_of_constraint;j++) {
2092911cabfeSStefano Zampini               temp_indices_to_constraint_work[j] = temp_indices_to_constraint[temp_indices[total_counts]+permutation[j]];
2093911cabfeSStefano Zampini               temp_quadrature_constraint_work[j] = temp_quadrature_constraint[temp_indices[total_counts]+permutation[j]];
2094911cabfeSStefano Zampini             }
2095911cabfeSStefano Zampini             ierr = PetscMemcpy(temp_indices_to_constraint+temp_indices[total_counts],temp_indices_to_constraint_work,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
2096911cabfeSStefano Zampini             ierr = PetscMemcpy(temp_quadrature_constraint+temp_indices[total_counts],temp_quadrature_constraint_work,size_of_constraint*sizeof(PetscScalar));CHKERRQ(ierr);
2097911cabfeSStefano Zampini           }
2098674ae819SStefano Zampini           temp_constraints++;
2099674ae819SStefano Zampini           temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
2100674ae819SStefano Zampini           total_counts++;
2101674ae819SStefano Zampini         }
2102674ae819SStefano Zampini       }
2103674ae819SStefano Zampini       ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
210445a1bb75SStefano Zampini       valid_constraints = temp_constraints;
2105eb97c9d2SStefano Zampini       if (!pcbddc->use_nnsp_true && temp_constraints) {
2106a773dcb8SStefano Zampini         if (temp_constraints == 1) { /* just normalize the constraint */
2107a773dcb8SStefano Zampini           PetscScalar norm;
2108a773dcb8SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2109a773dcb8SStefano 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));
2110a773dcb8SStefano Zampini           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
2111a773dcb8SStefano Zampini           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,temp_quadrature_constraint+temp_indices[temp_start_ptr],&Blas_one));
2112a773dcb8SStefano Zampini         } else { /* perform SVD */
2113984c4197SStefano Zampini           PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
2114674ae819SStefano Zampini 
2115674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
2116984c4197SStefano Zampini           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
2117984c4197SStefano Zampini              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
2118984c4197SStefano Zampini              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
2119984c4197SStefano Zampini                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
2120984c4197SStefano Zampini                 from that computed using LAPACKgesvd
2121984c4197SStefano Zampini              -> This is due to a different computation of eigenvectors in LAPACKheev
2122984c4197SStefano Zampini              -> The quality of the POD-computed basis will be the same */
2123984c4197SStefano Zampini           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
2124674ae819SStefano Zampini           /* Store upper triangular part of correlation matrix */
2125e310c8b4SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2126984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2127674ae819SStefano Zampini           for (j=0;j<temp_constraints;j++) {
2128674ae819SStefano Zampini             for (k=0;k<j+1;k++) {
2129cf5a6209SStefano 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));
2130674ae819SStefano Zampini             }
2131674ae819SStefano Zampini           }
2132e310c8b4SStefano Zampini           /* compute eigenvalues and eigenvectors of correlation matrix */
2133e310c8b4SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
2134e310c8b4SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
2135674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
2136c8244a33SStefano Zampini           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
2137674ae819SStefano Zampini #else
2138c8244a33SStefano Zampini           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
2139674ae819SStefano Zampini #endif
2140674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2141984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
2142984c4197SStefano Zampini           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
2143674ae819SStefano Zampini           j = 0;
2144984c4197SStefano Zampini           while (j < temp_constraints && singular_vals[j] < tol) j++;
2145674ae819SStefano Zampini           total_counts = total_counts-j;
214645a1bb75SStefano Zampini           valid_constraints = temp_constraints-j;
2147e310c8b4SStefano Zampini           /* scale and copy POD basis into used quadrature memory */
2148c4303822SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
2149c4303822SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
2150c4303822SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
2151c4303822SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2152c4303822SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
2153c4303822SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
2154674ae819SStefano Zampini           if (j<temp_constraints) {
2155984c4197SStefano Zampini             PetscInt ii;
2156984c4197SStefano Zampini             for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
2157674ae819SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2158c4303822SStefano 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));
2159674ae819SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
2160984c4197SStefano Zampini             for (k=0;k<temp_constraints-j;k++) {
2161674ae819SStefano Zampini               for (ii=0;ii<size_of_constraint;ii++) {
2162984c4197SStefano 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];
2163674ae819SStefano Zampini               }
2164674ae819SStefano Zampini             }
2165674ae819SStefano Zampini           }
2166674ae819SStefano Zampini #else  /* on missing GESVD */
2167e310c8b4SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
2168e310c8b4SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
2169b7d8b9f8SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2170674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2171674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
2172cf5a6209SStefano 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));
2173674ae819SStefano Zampini #else
2174cf5a6209SStefano 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));
2175674ae819SStefano Zampini #endif
2176984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
2177674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2178984c4197SStefano Zampini           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
2179e310c8b4SStefano Zampini           k = temp_constraints;
2180e310c8b4SStefano Zampini           if (k > size_of_constraint) k = size_of_constraint;
2181674ae819SStefano Zampini           j = 0;
2182e310c8b4SStefano Zampini           while (j < k && singular_vals[k-j-1] < tol) j++;
218345a1bb75SStefano Zampini           valid_constraints = k-j;
2184911cabfeSStefano Zampini           total_counts = total_counts-temp_constraints+valid_constraints;
2185984c4197SStefano Zampini #endif /* on missing GESVD */
2186674ae819SStefano Zampini         }
2187a773dcb8SStefano Zampini       }
218845a1bb75SStefano Zampini       /* setting change_of_basis flag is safe now */
218945a1bb75SStefano Zampini       if (boolforchange) {
219045a1bb75SStefano Zampini         for (j=0;j<valid_constraints;j++) {
219145a1bb75SStefano Zampini           PetscBTSet(change_basis,total_counts-j-1);
219245a1bb75SStefano Zampini         }
219345a1bb75SStefano Zampini       }
2194674ae819SStefano Zampini     }
2195984c4197SStefano Zampini     /* free workspace */
21968f1c130eSStefano Zampini     if (!skip_lapack || pcbddc->use_qr_single) {
2197911cabfeSStefano Zampini       ierr = PetscFree4(gidxs,permutation,temp_indices_to_constraint_work,temp_quadrature_constraint_work);CHKERRQ(ierr);
21988f1c130eSStefano Zampini     }
21998f1c130eSStefano Zampini     if (!skip_lapack) {
2200984c4197SStefano Zampini       ierr = PetscFree(work);CHKERRQ(ierr);
2201984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
2202984c4197SStefano Zampini       ierr = PetscFree(rwork);CHKERRQ(ierr);
2203984c4197SStefano Zampini #endif
2204984c4197SStefano Zampini       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
2205984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
2206984c4197SStefano Zampini       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
2207984c4197SStefano Zampini       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
2208984c4197SStefano Zampini #endif
2209984c4197SStefano Zampini     }
2210984c4197SStefano Zampini     for (k=0;k<nnsp_size;k++) {
2211984c4197SStefano Zampini       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
2212984c4197SStefano Zampini     }
2213984c4197SStefano Zampini     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
2214cf5a6209SStefano Zampini     /* free index sets of faces, edges and vertices */
2215cf5a6209SStefano Zampini     for (i=0;i<n_ISForFaces;i++) {
2216cf5a6209SStefano Zampini       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
2217cf5a6209SStefano Zampini     }
2218cf5a6209SStefano Zampini     if (n_ISForFaces) {
2219cf5a6209SStefano Zampini       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
2220cf5a6209SStefano Zampini     }
2221cf5a6209SStefano Zampini     for (i=0;i<n_ISForEdges;i++) {
2222cf5a6209SStefano Zampini       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
2223cf5a6209SStefano Zampini     }
2224cf5a6209SStefano Zampini     if (n_ISForEdges) {
2225cf5a6209SStefano Zampini       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
2226cf5a6209SStefano Zampini     }
2227cf5a6209SStefano Zampini     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
222808122e43SStefano Zampini   } else {
222908122e43SStefano Zampini     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
223008122e43SStefano Zampini     PetscInt        cum = 0;
223108122e43SStefano Zampini 
223208122e43SStefano Zampini     total_counts = 0;
223308122e43SStefano Zampini     n_vertices = 0;
22348bec7fa6SStefano Zampini     if (sub_schurs->is_Ej_com && pcbddc->use_vertices) {
223508122e43SStefano Zampini       ierr = ISGetLocalSize(sub_schurs->is_Ej_com,&n_vertices);CHKERRQ(ierr);
223608122e43SStefano Zampini     }
223708122e43SStefano Zampini     max_constraints = 0;
223808122e43SStefano Zampini     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
223908122e43SStefano Zampini       total_counts += pcbddc->adaptive_constraints_n[i];
224008122e43SStefano Zampini       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
224108122e43SStefano Zampini     }
224208122e43SStefano Zampini     temp_indices = pcbddc->adaptive_constraints_ptrs;
224308122e43SStefano Zampini     temp_indices_to_constraint = pcbddc->adaptive_constraints_idxs;
224408122e43SStefano Zampini     temp_quadrature_constraint = pcbddc->adaptive_constraints_data;
224508122e43SStefano Zampini 
224608122e43SStefano Zampini #if 0
224708122e43SStefano Zampini     printf("Found %d totals\n",total_counts);
224808122e43SStefano Zampini     for (i=0;i<total_counts;i++) {
224908122e43SStefano Zampini       printf("const %d, start %d",i,temp_indices[i]);
225008122e43SStefano Zampini       printf(" end %d:\n",temp_indices[i+1]);
225108122e43SStefano Zampini       for (j=temp_indices[i];j<temp_indices[i+1];j++) {
225208122e43SStefano Zampini         printf("  idxs %d",temp_indices_to_constraint[j]);
225308122e43SStefano Zampini         printf("  data %1.2e\n",temp_quadrature_constraint[j]);
225408122e43SStefano Zampini       }
225508122e43SStefano Zampini     }
22561b968477SStefano Zampini     for (i=0;i<n_vertices;i++) {
22578bec7fa6SStefano Zampini       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
22581b968477SStefano Zampini     }
22591b968477SStefano Zampini     for (i=0;i<sub_schurs->n_subs;i++) {
22608bec7fa6SStefano 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]);
22611b968477SStefano Zampini     }
226208122e43SStefano Zampini #endif
226308122e43SStefano Zampini 
22648bec7fa6SStefano Zampini     max_size_of_constraint = 0;
226508122e43SStefano Zampini     for (i=0;i<total_counts;i++) max_size_of_constraint = PetscMax(max_size_of_constraint,temp_indices[i+1]-temp_indices[i]);
226608122e43SStefano Zampini     ierr = PetscMalloc1(temp_indices[total_counts],&temp_indices_to_constraint_B);CHKERRQ(ierr);
226708122e43SStefano Zampini     /* Change of basis */
226808122e43SStefano Zampini     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
226908122e43SStefano Zampini     if (pcbddc->use_change_of_basis) {
2270bbb9e6c6SStefano Zampini       cum = n_vertices;
227108122e43SStefano Zampini       for (i=0;i<sub_schurs->n_subs;i++) {
227208122e43SStefano Zampini         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
2273bbb9e6c6SStefano Zampini           for (j=0;j<pcbddc->adaptive_constraints_n[i+n_vertices];j++) {
227408122e43SStefano Zampini             ierr = PetscBTSet(change_basis,cum+j);CHKERRQ(ierr);
227508122e43SStefano Zampini           }
227608122e43SStefano Zampini         }
2277bbb9e6c6SStefano Zampini         cum += pcbddc->adaptive_constraints_n[i+n_vertices];
227808122e43SStefano Zampini       }
227908122e43SStefano Zampini     }
228008122e43SStefano Zampini   }
228108122e43SStefano Zampini 
228208122e43SStefano Zampini   /* map temp_indices_to_constraint in boundary numbering */
228308122e43SStefano Zampini   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,temp_indices[total_counts],temp_indices_to_constraint,&i,temp_indices_to_constraint_B);CHKERRQ(ierr);
228408122e43SStefano Zampini   if (i != temp_indices[total_counts]) {
228508122e43SStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for constraints indices %d != %d\n",temp_indices[total_counts],i);
228608122e43SStefano Zampini   }
2287984c4197SStefano Zampini 
2288727cdba6SStefano Zampini   /* set quantities in pcbddc data structure and store previous primal size */
2289984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
2290674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
2291727cdba6SStefano Zampini   olocal_primal_size = pcbddc->local_primal_size;
2292984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
2293674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
2294984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
2295674ae819SStefano Zampini 
2296674ae819SStefano Zampini   /* Create constraint matrix */
2297674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
2298674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
2299674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
230016f15bc4SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
2301984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
2302984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
2303785e854fSJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&aux_primal_numbering);CHKERRQ(ierr);
2304984c4197SStefano Zampini   /* array to select the proper local node (of minimum index with respect to global ordering) when changing the basis */
2305984c4197SStefano 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 */
2306785e854fSJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&aux_primal_minloc);CHKERRQ(ierr);
2307984c4197SStefano Zampini   /* auxiliary stuff for basis change */
2308785e854fSJed Brown   ierr = PetscMalloc1(max_size_of_constraint,&global_indices);CHKERRQ(ierr);
23094641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n_B,&touched);CHKERRQ(ierr);
2310984c4197SStefano Zampini 
2311984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
2312984c4197SStefano Zampini   total_primal_vertices=0;
2313984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
2314674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
2315984c4197SStefano Zampini     if (size_of_constraint == 1) {
23164641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]]);CHKERRQ(ierr);
2317984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]];
2318984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=0;
2319984c4197SStefano Zampini       total_primal_vertices++;
23204641a718SStefano Zampini     } else if (PetscBTLookup(change_basis,i)) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */
2321984c4197SStefano Zampini       PetscInt min_loc,min_index;
2322984c4197SStefano Zampini       ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],global_indices);CHKERRQ(ierr);
2323984c4197SStefano Zampini       /* find first untouched local node */
2324674ae819SStefano Zampini       k = 0;
23254641a718SStefano Zampini       while (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) k++;
2326984c4197SStefano Zampini       min_index = global_indices[k];
2327984c4197SStefano Zampini       min_loc = k;
2328984c4197SStefano Zampini       /* search the minimum among global nodes already untouched on the cc */
2329984c4197SStefano Zampini       for (k=1;k<size_of_constraint;k++) {
2330984c4197SStefano Zampini         /* there can be more than one constraint on a single connected component */
23314641a718SStefano Zampini         if (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k]) && min_index > global_indices[k]) {
2332984c4197SStefano Zampini           min_index = global_indices[k];
2333984c4197SStefano Zampini           min_loc = k;
2334674ae819SStefano Zampini         }
2335674ae819SStefano Zampini       }
23364641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+min_loc]);CHKERRQ(ierr);
2337984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]+min_loc];
2338984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=min_loc;
2339984c4197SStefano Zampini       total_primal_vertices++;
2340984c4197SStefano Zampini     }
2341984c4197SStefano Zampini   }
2342a717540cSStefano Zampini   /* determine if a QR strategy is needed for change of basis */
2343a717540cSStefano Zampini   qr_needed = PETSC_FALSE;
2344a717540cSStefano Zampini   ierr = PetscBTCreate(pcbddc->local_primal_size,&qr_needed_idx);CHKERRQ(ierr);
2345a717540cSStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
2346a717540cSStefano Zampini     if (PetscBTLookup(change_basis,i)) {
2347ac632422SStefano Zampini       if (!pcbddc->use_qr_single && !pcbddc->faster_deluxe) {
2348a717540cSStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
2349a717540cSStefano Zampini         j = 0;
2350a717540cSStefano Zampini         for (k=0;k<size_of_constraint;k++) {
2351a717540cSStefano Zampini           if (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) {
2352a717540cSStefano Zampini             j++;
2353a717540cSStefano Zampini           }
2354a717540cSStefano Zampini         }
2355a717540cSStefano Zampini         /* found more than one primal dof on the cc */
2356a717540cSStefano Zampini         if (j > 1) {
2357a717540cSStefano Zampini           PetscBTSet(qr_needed_idx,i);
2358a717540cSStefano Zampini           qr_needed = PETSC_TRUE;
2359a717540cSStefano Zampini         }
2360fa434743SStefano Zampini       } else {
2361fa434743SStefano Zampini         PetscBTSet(qr_needed_idx,i);
2362fa434743SStefano Zampini         qr_needed = PETSC_TRUE;
2363fa434743SStefano Zampini       }
2364a717540cSStefano Zampini     }
2365a717540cSStefano Zampini   }
2366984c4197SStefano Zampini   /* free workspace */
2367984c4197SStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
236845a1bb75SStefano Zampini 
2369674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
2370a717540cSStefano Zampini   ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering);CHKERRQ(ierr);
2371984c4197SStefano Zampini 
2372984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
2373785e854fSJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
2374984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
2375984c4197SStefano Zampini   j=total_primal_vertices;
2376984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
23774641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
2378674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
2379674ae819SStefano Zampini       j++;
2380674ae819SStefano Zampini     }
2381674ae819SStefano Zampini   }
2382674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
2383674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
2384674ae819SStefano Zampini   /* set values in constraint matrix */
2385984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
2386984c4197SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
2387674ae819SStefano Zampini   }
2388984c4197SStefano Zampini   total_counts = total_primal_vertices;
2389984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
23904641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
2391674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
2392674ae819SStefano 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);
2393674ae819SStefano Zampini       total_counts++;
2394674ae819SStefano Zampini     }
2395674ae819SStefano Zampini   }
2396674ae819SStefano Zampini   /* assembling */
2397674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2398674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2399984c4197SStefano Zampini   /*
240045a1bb75SStefano Zampini   ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
2401984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
2402984c4197SStefano Zampini   */
2403674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
2404674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
2405026de310SStefano Zampini     /* dual and primal dofs on a single cc */
2406984c4197SStefano Zampini     PetscInt     dual_dofs,primal_dofs;
2407026de310SStefano Zampini     /* iterator on aux_primal_minloc (ordered as read from nearnullspace: vertices, edges and then constraints) */
2408026de310SStefano Zampini     PetscInt     primal_counter;
2409984c4197SStefano Zampini     /* working stuff for GEQRF */
241081d9aea3SBarry Smith     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
2411984c4197SStefano Zampini     PetscBLASInt lqr_work;
2412984c4197SStefano Zampini     /* working stuff for UNGQR */
2413984c4197SStefano Zampini     PetscScalar  *gqr_work,lgqr_work_t;
2414984c4197SStefano Zampini     PetscBLASInt lgqr_work;
2415984c4197SStefano Zampini     /* working stuff for TRTRS */
2416984c4197SStefano Zampini     PetscScalar  *trs_rhs;
24173f08241aSStefano Zampini     PetscBLASInt Blas_NRHS;
2418984c4197SStefano Zampini     /* pointers for values insertion into change of basis matrix */
2419984c4197SStefano Zampini     PetscInt     *start_rows,*start_cols;
2420984c4197SStefano Zampini     PetscScalar  *start_vals;
2421984c4197SStefano Zampini     /* working stuff for values insertion */
24224641a718SStefano Zampini     PetscBT      is_primal;
2423906d46d4SStefano Zampini     /* matrix sizes */
2424906d46d4SStefano Zampini     PetscInt     global_size,local_size;
2425906d46d4SStefano Zampini     /* temporary change of basis */
2426906d46d4SStefano Zampini     Mat          localChangeOfBasisMatrix;
2427cf5a6209SStefano Zampini     /* extra space for debugging */
2428cf5a6209SStefano Zampini     PetscScalar  *dbg_work;
2429984c4197SStefano Zampini 
2430906d46d4SStefano Zampini     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
2431906d46d4SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
243216f15bc4SStefano Zampini     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
2433bbb9e6c6SStefano Zampini     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
2434906d46d4SStefano Zampini     /* nonzeros for local mat */
2435bbb9e6c6SStefano Zampini     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
2436bbb9e6c6SStefano Zampini     for (i=0;i<pcis->n;i++) nnz[i]=1;
2437a717540cSStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
2438a717540cSStefano Zampini       if (PetscBTLookup(change_basis,i)) {
2439a717540cSStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
2440a717540cSStefano Zampini         if (PetscBTLookup(qr_needed_idx,i)) {
2441bbb9e6c6SStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint[temp_indices[i]+j]] = size_of_constraint;
2442a717540cSStefano Zampini         } else {
2443bbb9e6c6SStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint[temp_indices[i]+j]] = 2;
2444a717540cSStefano Zampini           /* get local primal index on the cc */
2445a717540cSStefano Zampini           j = 0;
2446a717540cSStefano Zampini           while (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+j])) j++;
2447bbb9e6c6SStefano Zampini           nnz[temp_indices_to_constraint[temp_indices[i]+j]] = size_of_constraint;
2448a717540cSStefano Zampini         }
2449a717540cSStefano Zampini       }
2450a717540cSStefano Zampini     }
2451906d46d4SStefano Zampini     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
2452bbb9e6c6SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
2453a717540cSStefano Zampini     /* Set initial identity in the matrix */
2454bbb9e6c6SStefano Zampini     for (i=0;i<pcis->n;i++) {
2455906d46d4SStefano Zampini       ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
2456a717540cSStefano Zampini     }
2457a717540cSStefano Zampini 
2458a717540cSStefano Zampini     if (pcbddc->dbg_flag) {
2459a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
2460a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
2461a717540cSStefano Zampini     }
2462a717540cSStefano Zampini 
2463a717540cSStefano Zampini 
2464a717540cSStefano Zampini     /* Now we loop on the constraints which need a change of basis */
2465a717540cSStefano Zampini     /*
2466a717540cSStefano Zampini        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
2467a717540cSStefano Zampini        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
2468a717540cSStefano Zampini 
2469a6b551f4SStefano Zampini        Basic blocks of change of basis matrix T computed by
2470a717540cSStefano Zampini 
2471a6b551f4SStefano 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)
2472a6b551f4SStefano Zampini 
2473a6b551f4SStefano Zampini             | 1        0   ...        0         s_1/S |
2474a6b551f4SStefano Zampini             | 0        1   ...        0         s_2/S |
2475a717540cSStefano Zampini             |              ...                        |
2476a6b551f4SStefano Zampini             | 0        ...            1     s_{n-1}/S |
2477a6b551f4SStefano Zampini             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
2478a717540cSStefano Zampini 
2479a6b551f4SStefano Zampini             with S = \sum_{i=1}^n s_i^2
2480a6b551f4SStefano Zampini             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
2481a6b551f4SStefano Zampini                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
2482a6b551f4SStefano Zampini 
2483a6b551f4SStefano Zampini           - QR decomposition of constraints otherwise
2484a717540cSStefano Zampini     */
2485a717540cSStefano Zampini     if (qr_needed) {
2486984c4197SStefano Zampini       /* space to store Q */
2487854ce69bSBarry Smith       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
2488984c4197SStefano Zampini       /* first we issue queries for optimal work */
24893f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
24903f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
24913f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2492984c4197SStefano Zampini       lqr_work = -1;
24933f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
2494984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
2495984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
2496785e854fSJed Brown       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
2497984c4197SStefano Zampini       lgqr_work = -1;
24983f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
24993f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
25003f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
25013f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
25023f08241aSStefano Zampini       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
25033f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
2504984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
2505984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
2506785e854fSJed Brown       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
2507984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
2508785e854fSJed Brown       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
2509984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
2510785e854fSJed Brown       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
2511a717540cSStefano Zampini       /* allocating workspace for check */
2512a717540cSStefano Zampini       if (pcbddc->dbg_flag) {
2513cf5a6209SStefano Zampini         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
2514a717540cSStefano Zampini       }
2515a717540cSStefano Zampini     }
2516984c4197SStefano Zampini     /* array to store whether a node is primal or not */
25174641a718SStefano Zampini     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
2518473ba861SJed Brown     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
25195e8657edSStefano Zampini     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,aux_primal_numbering,&i,aux_primal_numbering_B);CHKERRQ(ierr);
252039e2fb2aSStefano Zampini     if (i != total_primal_vertices) {
252139e2fb2aSStefano Zampini       SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",total_primal_vertices,i);
25224641a718SStefano Zampini     }
252339e2fb2aSStefano Zampini     for (i=0;i<total_primal_vertices;i++) {
252439e2fb2aSStefano Zampini       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
252539e2fb2aSStefano Zampini     }
252639e2fb2aSStefano Zampini     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
2527984c4197SStefano Zampini 
2528a717540cSStefano Zampini     /* loop on constraints and see whether or not they need a change of basis and compute it */
2529026de310SStefano Zampini     /* -> using implicit ordering contained in temp_indices data */
2530026de310SStefano Zampini     total_counts = pcbddc->n_vertices;
2531026de310SStefano Zampini     primal_counter = total_counts;
2532026de310SStefano Zampini     while (total_counts<pcbddc->local_primal_size) {
2533026de310SStefano Zampini       primal_dofs = 1;
25344641a718SStefano Zampini       if (PetscBTLookup(change_basis,total_counts)) {
2535026de310SStefano Zampini         /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
2536bbb9e6c6SStefano 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]]) {
2537026de310SStefano Zampini           primal_dofs++;
2538674ae819SStefano Zampini         }
2539984c4197SStefano Zampini         /* get constraint info */
2540026de310SStefano Zampini         size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
2541984c4197SStefano Zampini         dual_dofs = size_of_constraint-primal_dofs;
2542984c4197SStefano Zampini 
2543984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
2544a717540cSStefano 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);
2545674ae819SStefano Zampini         }
2546984c4197SStefano Zampini 
2547fa434743SStefano Zampini         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
2548a717540cSStefano Zampini 
2549a717540cSStefano Zampini           /* copy quadrature constraints for change of basis check */
2550a717540cSStefano Zampini           if (pcbddc->dbg_flag) {
2551cf5a6209SStefano Zampini             ierr = PetscMemcpy(dbg_work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
2552a717540cSStefano Zampini           }
2553984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
2554026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
2555984c4197SStefano Zampini 
2556984c4197SStefano Zampini           /* compute QR decomposition of constraints */
25573f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
25583f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
25593f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2560674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
25613f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
2562984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
2563674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2564984c4197SStefano Zampini 
2565984c4197SStefano Zampini           /* explictly compute R^-T */
2566984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
2567984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
25683f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
25693f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
25703f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
25713f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
2572984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
25733f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
2574984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
2575984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2576984c4197SStefano Zampini 
2577a717540cSStefano Zampini           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
25783f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
25793f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
25803f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
25813f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2582984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
25833f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
2584984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
2585984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2586984c4197SStefano Zampini 
2587984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
2588984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
2589984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
25903f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
25913f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
25923f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
25933f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
25943f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
25953f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
2596984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2597c4303822SStefano 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));
2598984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2599026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
2600984c4197SStefano Zampini 
2601984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
2602bbb9e6c6SStefano Zampini           start_rows = &temp_indices_to_constraint[temp_indices[total_counts]];
2603984c4197SStefano Zampini           /* insert cols for primal dofs */
2604984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
2605984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
2606bbb9e6c6SStefano Zampini             start_cols = &temp_indices_to_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter+j]];
2607906d46d4SStefano Zampini             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
2608984c4197SStefano Zampini           }
2609984c4197SStefano Zampini           /* insert cols for dual dofs */
2610984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
26114641a718SStefano Zampini             if (!PetscBTLookup(is_primal,temp_indices_to_constraint_B[temp_indices[total_counts]+k])) {
2612984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
2613bbb9e6c6SStefano Zampini               start_cols = &temp_indices_to_constraint[temp_indices[total_counts]+k];
2614906d46d4SStefano Zampini               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
2615984c4197SStefano Zampini               j++;
2616674ae819SStefano Zampini             }
2617674ae819SStefano Zampini           }
2618984c4197SStefano Zampini 
2619984c4197SStefano Zampini           /* check change of basis */
2620984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
2621984c4197SStefano Zampini             PetscInt   ii,jj;
2622984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
2623c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
2624c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2625c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
2626c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2627c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
2628c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
2629984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2630cf5a6209SStefano 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));
2631984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
2632984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
2633984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
2634cf5a6209SStefano Zampini                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
2635cf5a6209SStefano 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;
2636674ae819SStefano Zampini               }
2637674ae819SStefano Zampini             }
2638984c4197SStefano Zampini             if (!valid_qr) {
263922d5777bSStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
2640984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
2641984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
2642cf5a6209SStefano Zampini                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
2643cf5a6209SStefano 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]));
2644674ae819SStefano Zampini                   }
2645cf5a6209SStefano Zampini                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
2646cf5a6209SStefano 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]));
2647984c4197SStefano Zampini                   }
2648984c4197SStefano Zampini                 }
2649984c4197SStefano Zampini               }
2650674ae819SStefano Zampini             } else {
265122d5777bSStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
2652674ae819SStefano Zampini             }
2653674ae819SStefano Zampini           }
2654a717540cSStefano Zampini         } else { /* simple transformation block */
2655a717540cSStefano Zampini           PetscInt    row,col;
2656a6b551f4SStefano Zampini           PetscScalar val,norm;
2657a6b551f4SStefano Zampini 
2658a6b551f4SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2659a6b551f4SStefano 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));
2660a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
2661bbb9e6c6SStefano Zampini             PetscInt row_B = temp_indices_to_constraint_B[temp_indices[total_counts]+j];
2662bbb9e6c6SStefano Zampini             row = temp_indices_to_constraint[temp_indices[total_counts]+j];
2663bbb9e6c6SStefano Zampini             if (!PetscBTLookup(is_primal,row_B)) {
2664bbb9e6c6SStefano Zampini               col = temp_indices_to_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
2665906d46d4SStefano Zampini               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
2666a6b551f4SStefano Zampini               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,temp_quadrature_constraint[temp_indices[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
2667a717540cSStefano Zampini             } else {
2668a717540cSStefano Zampini               for (k=0;k<size_of_constraint;k++) {
2669bbb9e6c6SStefano Zampini                 col = temp_indices_to_constraint[temp_indices[total_counts]+k];
2670a717540cSStefano Zampini                 if (row != col) {
2671a717540cSStefano Zampini                   val = -temp_quadrature_constraint[temp_indices[total_counts]+k]/temp_quadrature_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
2672a717540cSStefano Zampini                 } else {
2673a6b551f4SStefano Zampini                   val = temp_quadrature_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter]]/norm;
2674a717540cSStefano Zampini                 }
2675906d46d4SStefano Zampini                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
2676a717540cSStefano Zampini               }
2677a717540cSStefano Zampini             }
2678a717540cSStefano Zampini           }
267998a51de6SStefano Zampini           if (pcbddc->dbg_flag) {
268022d5777bSStefano Zampini             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
2681a717540cSStefano Zampini           }
2682674ae819SStefano Zampini         }
2683026de310SStefano Zampini         /* increment primal counter */
2684026de310SStefano Zampini         primal_counter += primal_dofs;
2685984c4197SStefano Zampini       } else {
2686984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
2687026de310SStefano 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);
2688674ae819SStefano Zampini         }
2689674ae819SStefano Zampini       }
2690026de310SStefano Zampini       /* increment constraint counter total_counts */
2691026de310SStefano Zampini       total_counts += primal_dofs;
2692674ae819SStefano Zampini     }
2693a717540cSStefano Zampini 
2694a717540cSStefano Zampini     /* free workspace */
2695a717540cSStefano Zampini     if (qr_needed) {
2696984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
2697cf5a6209SStefano Zampini         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
2698984c4197SStefano Zampini       }
2699984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
2700984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
2701984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
2702984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
2703984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
2704674ae819SStefano Zampini     }
2705a717540cSStefano Zampini     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
2706906d46d4SStefano Zampini     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2707906d46d4SStefano Zampini     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2708906d46d4SStefano Zampini 
2709906d46d4SStefano Zampini     /* assembling of global change of variable */
2710bbb9e6c6SStefano Zampini     {
2711bbb9e6c6SStefano Zampini       Mat      tmat;
271216f15bc4SStefano Zampini       PetscInt bs;
271316f15bc4SStefano Zampini 
2714906d46d4SStefano Zampini       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
2715906d46d4SStefano Zampini       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
2716bbb9e6c6SStefano Zampini       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
2717bbb9e6c6SStefano Zampini       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
2718bbb9e6c6SStefano Zampini       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
2719bbb9e6c6SStefano Zampini       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
272016f15bc4SStefano Zampini       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
272116f15bc4SStefano Zampini       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
2722906d46d4SStefano Zampini       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
2723bbb9e6c6SStefano Zampini       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
2724bbb9e6c6SStefano Zampini       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
2725bbb9e6c6SStefano Zampini       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
2726bbb9e6c6SStefano Zampini       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
2727bbb9e6c6SStefano Zampini       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
2728bbb9e6c6SStefano Zampini       ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2729bbb9e6c6SStefano Zampini       ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2730bbb9e6c6SStefano Zampini       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
2731bbb9e6c6SStefano Zampini       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
2732906d46d4SStefano Zampini     }
2733906d46d4SStefano Zampini     /* check */
2734906d46d4SStefano Zampini     if (pcbddc->dbg_flag) {
2735906d46d4SStefano Zampini       PetscReal error;
2736906d46d4SStefano Zampini       Vec       x,x_change;
2737906d46d4SStefano Zampini 
2738906d46d4SStefano Zampini       ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
2739906d46d4SStefano Zampini       ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
2740906d46d4SStefano Zampini       ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
2741906d46d4SStefano Zampini       ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
2742bbb9e6c6SStefano Zampini       ierr = VecScatterBegin(matis->ctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2743bbb9e6c6SStefano Zampini       ierr = VecScatterEnd(matis->ctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2744bbb9e6c6SStefano Zampini       ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
2745bbb9e6c6SStefano Zampini       ierr = VecScatterBegin(matis->ctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2746bbb9e6c6SStefano Zampini       ierr = VecScatterEnd(matis->ctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2747906d46d4SStefano Zampini       ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
2748906d46d4SStefano Zampini       ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
2749906d46d4SStefano Zampini       ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
2750906d46d4SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2751bbb9e6c6SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Error global vs local change: %1.6e\n",error);CHKERRQ(ierr);
2752906d46d4SStefano Zampini       ierr = VecDestroy(&x);CHKERRQ(ierr);
2753906d46d4SStefano Zampini       ierr = VecDestroy(&x_change);CHKERRQ(ierr);
2754906d46d4SStefano Zampini     }
2755b96c3477SStefano Zampini 
2756b96c3477SStefano Zampini     /* adapt sub_schurs computed (if any) */
2757b96c3477SStefano Zampini     if (pcbddc->use_deluxe_scaling) {
2758b96c3477SStefano Zampini       PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
2759b96c3477SStefano Zampini       if (sub_schurs->S_Ej_all) {
2760ac632422SStefano Zampini         Mat S_new,tmat;
2761bbb9e6c6SStefano Zampini         IS is_all_N;
2762bbb9e6c6SStefano Zampini 
2763bbb9e6c6SStefano Zampini         ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
2764d648f858SStefano Zampini         ierr = MatGetSubMatrixUnsorted(localChangeOfBasisMatrix,is_all_N,is_all_N,&tmat);CHKERRQ(ierr);
2765bbb9e6c6SStefano Zampini         ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
2766ac632422SStefano Zampini         ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
2767b96c3477SStefano Zampini         ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
2768ac632422SStefano Zampini         ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
2769ac632422SStefano Zampini         sub_schurs->S_Ej_all = S_new;
2770ac632422SStefano Zampini         ierr = MatDestroy(&S_new);CHKERRQ(ierr);
2771ac632422SStefano Zampini         if (sub_schurs->sum_S_Ej_all) {
2772ac632422SStefano Zampini           ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
2773b96c3477SStefano Zampini           ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
2774ac632422SStefano Zampini           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
2775ac632422SStefano Zampini           sub_schurs->sum_S_Ej_all = S_new;
2776ac632422SStefano Zampini           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
2777ac632422SStefano Zampini         }
2778b96c3477SStefano Zampini         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
2779b96c3477SStefano Zampini       }
2780b96c3477SStefano Zampini     }
2781906d46d4SStefano Zampini     ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
2782906d46d4SStefano Zampini   } else if (pcbddc->user_ChangeOfBasisMatrix) {
2783b9b85e73SStefano Zampini     ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
2784b9b85e73SStefano Zampini     pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
2785b9b85e73SStefano Zampini   }
2786906d46d4SStefano Zampini 
2787906d46d4SStefano Zampini   /* set up change of basis context */
2788906d46d4SStefano Zampini   if (pcbddc->ChangeOfBasisMatrix) {
2789906d46d4SStefano Zampini     PCBDDCChange_ctx change_ctx;
2790906d46d4SStefano Zampini 
2791906d46d4SStefano Zampini     if (!pcbddc->new_global_mat) {
2792906d46d4SStefano Zampini       PetscInt global_size,local_size;
2793906d46d4SStefano Zampini 
2794906d46d4SStefano Zampini       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
2795906d46d4SStefano Zampini       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
2796906d46d4SStefano Zampini       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->new_global_mat);CHKERRQ(ierr);
2797906d46d4SStefano Zampini       ierr = MatSetSizes(pcbddc->new_global_mat,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
2798906d46d4SStefano Zampini       ierr = MatSetType(pcbddc->new_global_mat,MATSHELL);CHKERRQ(ierr);
2799906d46d4SStefano Zampini       ierr = MatShellSetOperation(pcbddc->new_global_mat,MATOP_MULT,(void (*)(void))PCBDDCMatMult_Private);CHKERRQ(ierr);
2800906d46d4SStefano Zampini       ierr = MatShellSetOperation(pcbddc->new_global_mat,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCMatMultTranspose_Private);CHKERRQ(ierr);
2801906d46d4SStefano Zampini       ierr = PetscNew(&change_ctx);CHKERRQ(ierr);
2802906d46d4SStefano Zampini       ierr = MatShellSetContext(pcbddc->new_global_mat,change_ctx);CHKERRQ(ierr);
2803906d46d4SStefano Zampini     } else {
2804906d46d4SStefano Zampini       ierr = MatShellGetContext(pcbddc->new_global_mat,&change_ctx);CHKERRQ(ierr);
2805906d46d4SStefano Zampini       ierr = MatDestroy(&change_ctx->global_change);CHKERRQ(ierr);
2806906d46d4SStefano Zampini       ierr = VecDestroyVecs(2,&change_ctx->work);CHKERRQ(ierr);
2807906d46d4SStefano Zampini     }
2808906d46d4SStefano Zampini     if (!pcbddc->user_ChangeOfBasisMatrix) {
2809906d46d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
2810906d46d4SStefano Zampini       change_ctx->global_change = pcbddc->ChangeOfBasisMatrix;
2811906d46d4SStefano Zampini     } else {
2812906d46d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
2813906d46d4SStefano Zampini       change_ctx->global_change = pcbddc->user_ChangeOfBasisMatrix;
2814906d46d4SStefano Zampini     }
2815906d46d4SStefano Zampini     ierr = VecDuplicateVecs(pcis->vec1_global,2,&change_ctx->work);CHKERRQ(ierr);
2816906d46d4SStefano Zampini     ierr = MatSetUp(pcbddc->new_global_mat);CHKERRQ(ierr);
2817906d46d4SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->new_global_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2818906d46d4SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->new_global_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2819b9b85e73SStefano Zampini   }
2820a717540cSStefano Zampini 
2821727cdba6SStefano Zampini   /* get indices in local ordering for vertices and constraints */
2822727cdba6SStefano 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 */
2823473ba861SJed Brown     ierr = PetscMalloc1(olocal_primal_size,&oprimal_indices_local_idxs);CHKERRQ(ierr);
2824727cdba6SStefano Zampini     ierr = PetscMemcpy(oprimal_indices_local_idxs,pcbddc->primal_indices_local_idxs,olocal_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
2825727cdba6SStefano Zampini   }
2826727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2827f347579bSStefano Zampini   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
2828473ba861SJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
2829727cdba6SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_primal_numbering);CHKERRQ(ierr);
2830727cdba6SStefano Zampini   ierr = PetscMemcpy(pcbddc->primal_indices_local_idxs,aux_primal_numbering,i*sizeof(PetscInt));CHKERRQ(ierr);
2831727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2832727cdba6SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_primal_numbering);CHKERRQ(ierr);
2833727cdba6SStefano Zampini   ierr = PetscMemcpy(&pcbddc->primal_indices_local_idxs[i],aux_primal_numbering,j*sizeof(PetscInt));CHKERRQ(ierr);
2834727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2835e9189074SStefano Zampini   /* set quantities in PCBDDC data struct */
2836e9189074SStefano Zampini   pcbddc->n_actual_vertices = i;
2837727cdba6SStefano Zampini   /* check if a new primal space has been introduced */
2838727cdba6SStefano Zampini   pcbddc->new_primal_space_local = PETSC_TRUE;
2839727cdba6SStefano Zampini   if (olocal_primal_size == pcbddc->local_primal_size) {
2840727cdba6SStefano Zampini     ierr = PetscMemcmp(pcbddc->primal_indices_local_idxs,oprimal_indices_local_idxs,olocal_primal_size,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
2841c1c8e736SStefano Zampini     pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
2842727cdba6SStefano Zampini     ierr = PetscFree(oprimal_indices_local_idxs);CHKERRQ(ierr);
2843727cdba6SStefano Zampini   }
2844727cdba6SStefano Zampini   /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
2845727cdba6SStefano Zampini   ierr = MPI_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2846727cdba6SStefano Zampini 
2847a717540cSStefano Zampini   /* flush dbg viewer */
2848b8ffe317SStefano Zampini   if (pcbddc->dbg_flag) {
2849b8ffe317SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2850b8ffe317SStefano Zampini   }
2851a717540cSStefano Zampini 
2852e310c8b4SStefano Zampini   /* free workspace */
2853a717540cSStefano Zampini   ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2854a717540cSStefano Zampini   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
2855984c4197SStefano Zampini   ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr);
28564641a718SStefano Zampini   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
285708122e43SStefano Zampini   if (!pcbddc->adaptive_selection) {
2858906d46d4SStefano Zampini     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
2859906d46d4SStefano Zampini     ierr = PetscFree3(temp_quadrature_constraint,temp_indices_to_constraint,temp_indices_to_constraint_B);CHKERRQ(ierr);
286008122e43SStefano Zampini   } else {
286108122e43SStefano Zampini     ierr = PetscFree4(pcbddc->adaptive_constraints_n,
286208122e43SStefano Zampini                       pcbddc->adaptive_constraints_ptrs,
286308122e43SStefano Zampini                       pcbddc->adaptive_constraints_idxs,
286408122e43SStefano Zampini                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
286508122e43SStefano Zampini     ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
286608122e43SStefano Zampini   }
2867674ae819SStefano Zampini   PetscFunctionReturn(0);
2868674ae819SStefano Zampini }
2869674ae819SStefano Zampini 
2870674ae819SStefano Zampini #undef __FUNCT__
2871674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
2872674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
2873674ae819SStefano Zampini {
2874674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
2875674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
2876674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
287763602bcaSStefano Zampini   PetscInt    ierr,i,vertex_size;
2878674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
2879674ae819SStefano Zampini 
2880674ae819SStefano Zampini   PetscFunctionBegin;
28818e61c736SStefano Zampini   /* Reset previously computed graph */
28828e61c736SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
2883674ae819SStefano Zampini   /* Init local Graph struct */
2884674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
2885674ae819SStefano Zampini 
2886575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
2887575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
2888575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
2889575ad6abSStefano Zampini   }
28909577ea80SStefano Zampini 
2891674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
28924d379d7bSStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
28934d379d7bSStefano Zampini     PetscInt  *xadj,*adjncy;
28944d379d7bSStefano Zampini     PetscInt  nvtxs;
2895e496cd5dSStefano Zampini     PetscBool flg_row=PETSC_FALSE;
2896674ae819SStefano Zampini 
28974d379d7bSStefano Zampini     if (pcbddc->use_local_adj) {
28982fffb893SStefano Zampini 
28992fffb893SStefano Zampini       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
29002fffb893SStefano Zampini       if (flg_row) {
29014d379d7bSStefano Zampini         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
2902b96c3477SStefano Zampini         pcbddc->computed_rowadj = PETSC_TRUE;
29032fffb893SStefano Zampini       }
29042fffb893SStefano Zampini       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
29052fffb893SStefano Zampini     } else if (pcbddc->current_level) { /* just compute subdomain's connected components for coarser levels */
29064d379d7bSStefano Zampini       IS                     is_dummy;
29074d379d7bSStefano Zampini       ISLocalToGlobalMapping l2gmap_dummy;
29084d379d7bSStefano Zampini       PetscInt               j,sum;
29094d379d7bSStefano Zampini       PetscInt               *cxadj,*cadjncy;
29104d379d7bSStefano Zampini       const PetscInt         *idxs;
29114d379d7bSStefano Zampini       PCBDDCGraph            graph;
29124d379d7bSStefano Zampini       PetscBT                is_on_boundary;
29134d379d7bSStefano Zampini 
29144d379d7bSStefano Zampini       ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n,0,1,&is_dummy);CHKERRQ(ierr);
29154d379d7bSStefano Zampini       ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
29164d379d7bSStefano Zampini       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
29174d379d7bSStefano Zampini       ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
29184d379d7bSStefano Zampini       ierr = PCBDDCGraphInit(graph,l2gmap_dummy);CHKERRQ(ierr);
29194d379d7bSStefano Zampini       ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2920e496cd5dSStefano Zampini       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2921e496cd5dSStefano Zampini       if (flg_row) {
29224d379d7bSStefano Zampini         graph->xadj = xadj;
29234d379d7bSStefano Zampini         graph->adjncy = adjncy;
2924e496cd5dSStefano Zampini       }
29254d379d7bSStefano Zampini       ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
29264d379d7bSStefano Zampini       ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2927e496cd5dSStefano Zampini       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
29284d379d7bSStefano Zampini 
29294d379d7bSStefano Zampini       if (pcbddc->dbg_flag) {
29304d379d7bSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"[%d] Found %d subdomains\n",PetscGlobalRank,graph->ncc);CHKERRQ(ierr);
29314d379d7bSStefano Zampini         for (i=0;i<graph->ncc;i++) {
29324d379d7bSStefano Zampini           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"[%d] %d cc size %d\n",PetscGlobalRank,i,graph->cptr[i+1]-graph->cptr[i]);CHKERRQ(ierr);
29334d379d7bSStefano Zampini         }
29344d379d7bSStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
29354d379d7bSStefano Zampini       }
29364d379d7bSStefano Zampini 
2937e496cd5dSStefano Zampini       ierr = PetscBTCreate(pcis->n,&is_on_boundary);CHKERRQ(ierr);
29384d379d7bSStefano Zampini       ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
29394d379d7bSStefano Zampini       for (i=0;i<pcis->n_B;i++) {
29404d379d7bSStefano Zampini         ierr = PetscBTSet(is_on_boundary,idxs[i]);CHKERRQ(ierr);
29414d379d7bSStefano Zampini       }
29424d379d7bSStefano Zampini       ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
29434d379d7bSStefano Zampini 
2944e496cd5dSStefano Zampini       ierr = PetscCalloc1(pcis->n+1,&cxadj);CHKERRQ(ierr);
29454d379d7bSStefano Zampini       sum = 0;
29464d379d7bSStefano Zampini       for (i=0;i<graph->ncc;i++) {
29474d379d7bSStefano Zampini         PetscInt sizecc = 0;
29484d379d7bSStefano Zampini         for (j=graph->cptr[i];j<graph->cptr[i+1];j++) {
29494d379d7bSStefano Zampini           if (PetscBTLookup(is_on_boundary,graph->queue[j])) {
29504d379d7bSStefano Zampini             sizecc++;
29514d379d7bSStefano Zampini           }
29524d379d7bSStefano Zampini         }
29534d379d7bSStefano Zampini         for (j=graph->cptr[i];j<graph->cptr[i+1];j++) {
29544d379d7bSStefano Zampini           if (PetscBTLookup(is_on_boundary,graph->queue[j])) {
29554d379d7bSStefano Zampini             cxadj[graph->queue[j]] = sizecc;
29564d379d7bSStefano Zampini           }
29574d379d7bSStefano Zampini         }
29584d379d7bSStefano Zampini         sum += sizecc*sizecc;
29594d379d7bSStefano Zampini       }
29604d379d7bSStefano Zampini       ierr = PetscMalloc1(sum,&cadjncy);CHKERRQ(ierr);
29614d379d7bSStefano Zampini       sum = 0;
2962e496cd5dSStefano Zampini       for (i=0;i<pcis->n;i++) {
29634d379d7bSStefano Zampini         PetscInt temp = cxadj[i];
29644d379d7bSStefano Zampini         cxadj[i] = sum;
29654d379d7bSStefano Zampini         sum += temp;
29664d379d7bSStefano Zampini       }
2967e496cd5dSStefano Zampini       cxadj[pcis->n] = sum;
29684d379d7bSStefano Zampini       for (i=0;i<graph->ncc;i++) {
29694d379d7bSStefano Zampini         for (j=graph->cptr[i];j<graph->cptr[i+1];j++) {
29704d379d7bSStefano Zampini           if (PetscBTLookup(is_on_boundary,graph->queue[j])) {
29714d379d7bSStefano Zampini             PetscInt k,sizecc = 0;
29724d379d7bSStefano Zampini             for (k=graph->cptr[i];k<graph->cptr[i+1];k++) {
29734d379d7bSStefano Zampini               if (PetscBTLookup(is_on_boundary,graph->queue[k])) {
29744d379d7bSStefano Zampini                 cadjncy[cxadj[graph->queue[j]]+sizecc]=graph->queue[k];
29754d379d7bSStefano Zampini                 sizecc++;
29764d379d7bSStefano Zampini               }
29774d379d7bSStefano Zampini             }
29784d379d7bSStefano Zampini           }
29794d379d7bSStefano Zampini         }
29804d379d7bSStefano Zampini       }
2981e496cd5dSStefano Zampini       if (pcis->n) {
2982e496cd5dSStefano Zampini         ierr = PCBDDCSetLocalAdjacencyGraph(pc,pcis->n,cxadj,cadjncy,PETSC_OWN_POINTER);CHKERRQ(ierr);
29834d379d7bSStefano Zampini       } else {
29844d379d7bSStefano Zampini         ierr = PetscFree(cxadj);CHKERRQ(ierr);
29854d379d7bSStefano Zampini         ierr = PetscFree(cadjncy);CHKERRQ(ierr);
29864d379d7bSStefano Zampini       }
29874d379d7bSStefano Zampini       graph->xadj = 0;
29884d379d7bSStefano Zampini       graph->adjncy = 0;
29894d379d7bSStefano Zampini       ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
29904d379d7bSStefano Zampini       ierr = PetscBTDestroy(&is_on_boundary);CHKERRQ(ierr);
29914d379d7bSStefano Zampini     }
2992674ae819SStefano Zampini   }
2993674ae819SStefano Zampini 
299463602bcaSStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting or PCBDDCSetDofsSplittingLocal */
2995674ae819SStefano Zampini   vertex_size = 1;
299663602bcaSStefano Zampini   if (pcbddc->user_provided_isfordofs) {
299763602bcaSStefano Zampini     if (pcbddc->n_ISForDofs) { /* need to convert from global to local and remove references to global dofs splitting */
299895ecbf38SStefano Zampini       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
299963602bcaSStefano Zampini       for (i=0;i<pcbddc->n_ISForDofs;i++) {
3000a7dc3881SStefano Zampini         ierr = PCBDDCGlobalToLocal(matis->ctx,pcis->vec1_global,pcis->vec1_N,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
300163602bcaSStefano Zampini         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
3002674ae819SStefano Zampini       }
300363602bcaSStefano Zampini       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
300463602bcaSStefano Zampini       pcbddc->n_ISForDofs = 0;
300563602bcaSStefano Zampini       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
3006674ae819SStefano Zampini     }
300763602bcaSStefano Zampini     /* mat block size as vertex size (used for elasticity with rigid body modes as nearnullspace) */
3008674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
300963602bcaSStefano Zampini   } else {
301063602bcaSStefano Zampini     if (!pcbddc->n_ISForDofsLocal) { /* field split not present, create it in local ordering */
301163602bcaSStefano Zampini       ierr = MatGetBlockSize(pc->pmat,&pcbddc->n_ISForDofsLocal);CHKERRQ(ierr);
3012854ce69bSBarry Smith       ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
301363602bcaSStefano Zampini       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
301463602bcaSStefano Zampini         ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),pcis->n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
301563602bcaSStefano Zampini       }
301663602bcaSStefano Zampini     }
3017674ae819SStefano Zampini   }
3018674ae819SStefano Zampini 
3019674ae819SStefano Zampini   /* Setup of Graph */
3020785d1243SStefano Zampini   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) { /* need to convert from global to local */
3021a7dc3881SStefano Zampini     ierr = PCBDDCGlobalToLocal(matis->ctx,pcis->vec1_global,pcis->vec1_N,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3022785d1243SStefano Zampini   }
3023785d1243SStefano Zampini   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) { /* need to convert from global to local */
3024a7dc3881SStefano Zampini     ierr = PCBDDCGlobalToLocal(matis->ctx,pcis->vec1_global,pcis->vec1_N,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3025785d1243SStefano Zampini   }
3026302440fdSBarry Smith   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices);CHKERRQ(ierr);
3027674ae819SStefano Zampini 
3028674ae819SStefano Zampini   /* Graph's connected components analysis */
3029674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
3030674ae819SStefano Zampini 
3031674ae819SStefano Zampini   /* print some info to stdout */
3032674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
3033302440fdSBarry Smith     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);CHKERRQ(ierr);
3034674ae819SStefano Zampini   }
3035fb180af4SStefano Zampini 
3036fb180af4SStefano Zampini   /* mark topography has done */
3037fb180af4SStefano Zampini   pcbddc->recompute_topography = PETSC_FALSE;
3038674ae819SStefano Zampini   PetscFunctionReturn(0);
3039674ae819SStefano Zampini }
3040674ae819SStefano Zampini 
3041674ae819SStefano Zampini #undef __FUNCT__
3042674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
3043f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt **vertices_idx)
3044674ae819SStefano Zampini {
3045674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
3046674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
3047674ae819SStefano Zampini   PetscErrorCode ierr;
3048674ae819SStefano Zampini 
3049674ae819SStefano Zampini   PetscFunctionBegin;
3050674ae819SStefano Zampini   n = 0;
3051674ae819SStefano Zampini   vertices = 0;
3052674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
3053674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
3054b120a5c6SStefano Zampini     for (i=0;i<local_primal_size;i++) {
3055b120a5c6SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
3056b120a5c6SStefano Zampini       if (size_of_constraint == 1) n++;
3057b120a5c6SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
3058b120a5c6SStefano Zampini     }
3059811e8ca2SStefano Zampini     if (vertices_idx) {
3060785e854fSJed Brown       ierr = PetscMalloc1(n,&vertices);CHKERRQ(ierr);
3061b120a5c6SStefano Zampini       n = 0;
3062674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
3063674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
3064674ae819SStefano Zampini         if (size_of_constraint == 1) {
3065674ae819SStefano Zampini           vertices[n++]=row_cmat_indices[0];
3066674ae819SStefano Zampini         }
3067674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
3068674ae819SStefano Zampini       }
3069674ae819SStefano Zampini     }
3070811e8ca2SStefano Zampini   }
3071674ae819SStefano Zampini   *n_vertices = n;
3072811e8ca2SStefano Zampini   if (vertices_idx) *vertices_idx = vertices;
3073674ae819SStefano Zampini   PetscFunctionReturn(0);
3074674ae819SStefano Zampini }
3075674ae819SStefano Zampini 
3076674ae819SStefano Zampini #undef __FUNCT__
3077674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
3078f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt **constraints_idx)
3079674ae819SStefano Zampini {
3080674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
3081674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
3082674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
30834641a718SStefano Zampini   PetscBT        touched;
3084674ae819SStefano Zampini   PetscErrorCode ierr;
3085674ae819SStefano Zampini 
3086f34684f1SStefano Zampini     /* This function assumes that the number of local constraints per connected component
3087f34684f1SStefano Zampini        is not greater than the number of nodes defined for the connected component
3088f34684f1SStefano Zampini        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
3089674ae819SStefano Zampini   PetscFunctionBegin;
3090674ae819SStefano Zampini   n = 0;
3091674ae819SStefano Zampini   constraints_index = 0;
3092674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
3093674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
3094674ae819SStefano Zampini     max_size_of_constraint = 0;
3095674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
3096674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
3097674ae819SStefano Zampini       if (size_of_constraint > 1) {
3098674ae819SStefano Zampini         n++;
3099674ae819SStefano Zampini       }
3100674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
3101674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
3102674ae819SStefano Zampini     }
3103811e8ca2SStefano Zampini     if (constraints_idx) {
3104785e854fSJed Brown       ierr = PetscMalloc1(n,&constraints_index);CHKERRQ(ierr);
3105785e854fSJed Brown       ierr = PetscMalloc1(max_size_of_constraint,&row_cmat_global_indices);CHKERRQ(ierr);
31064641a718SStefano Zampini       ierr = PetscBTCreate(local_size,&touched);CHKERRQ(ierr);
3107674ae819SStefano Zampini       n = 0;
3108674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
3109674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
3110674ae819SStefano Zampini         if (size_of_constraint > 1) {
3111674ae819SStefano Zampini           ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
311282d3d8afSStefano Zampini           /* find first untouched local node */
311382d3d8afSStefano Zampini           j = 0;
31144641a718SStefano Zampini           while (PetscBTLookup(touched,row_cmat_indices[j])) j++;
311582d3d8afSStefano Zampini           min_index = row_cmat_global_indices[j];
311682d3d8afSStefano Zampini           min_loc = j;
311782d3d8afSStefano Zampini           /* search the minimum among nodes not yet touched on the connected component
311882d3d8afSStefano Zampini              since there can be more than one constraint on a single cc */
3119674ae819SStefano Zampini           for (j=1;j<size_of_constraint;j++) {
31204641a718SStefano Zampini             if (!PetscBTLookup(touched,row_cmat_indices[j]) && min_index > row_cmat_global_indices[j]) {
3121674ae819SStefano Zampini               min_index = row_cmat_global_indices[j];
3122674ae819SStefano Zampini               min_loc = j;
3123674ae819SStefano Zampini             }
3124674ae819SStefano Zampini           }
31254641a718SStefano Zampini           ierr = PetscBTSet(touched,row_cmat_indices[min_loc]);CHKERRQ(ierr);
3126674ae819SStefano Zampini           constraints_index[n++] = row_cmat_indices[min_loc];
3127674ae819SStefano Zampini         }
3128674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
3129674ae819SStefano Zampini       }
31304641a718SStefano Zampini       ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
3131674ae819SStefano Zampini       ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
3132811e8ca2SStefano Zampini     }
3133811e8ca2SStefano Zampini   }
3134674ae819SStefano Zampini   *n_constraints = n;
3135811e8ca2SStefano Zampini   if (constraints_idx) *constraints_idx = constraints_index;
3136674ae819SStefano Zampini   PetscFunctionReturn(0);
3137674ae819SStefano Zampini }
3138674ae819SStefano Zampini 
3139674ae819SStefano Zampini #undef __FUNCT__
3140674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
3141674ae819SStefano 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[])
3142674ae819SStefano Zampini {
3143674ae819SStefano Zampini   Vec            local_vec,global_vec;
3144674ae819SStefano Zampini   IS             seqis,paris;
3145674ae819SStefano Zampini   VecScatter     scatter_ctx;
3146674ae819SStefano Zampini   PetscScalar    *array;
3147674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
3148674ae819SStefano Zampini   PetscScalar    globalsum;
3149674ae819SStefano Zampini   PetscInt       i,j,s;
315017ccb9bdSStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local,max_global;
315117ccb9bdSStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm;
315217ccb9bdSStefano Zampini   PetscInt       *dof_sizes,*dof_displs;
3153674ae819SStefano Zampini   PetscBool      first_found;
3154674ae819SStefano Zampini   PetscErrorCode ierr;
3155674ae819SStefano Zampini 
3156674ae819SStefano Zampini   PetscFunctionBegin;
3157674ae819SStefano Zampini   /* mpi buffers */
3158b9b85e73SStefano Zampini   ierr = MPI_Comm_size(comm,&size_prec_comm);CHKERRQ(ierr);
3159b9b85e73SStefano Zampini   ierr = MPI_Comm_rank(comm,&rank_prec_comm);CHKERRQ(ierr);
3160674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
316117ccb9bdSStefano Zampini   ierr = PetscMalloc2(j,&dof_sizes,j,&dof_displs);CHKERRQ(ierr);
3162674ae819SStefano Zampini   /* get maximum size of subset */
3163785e854fSJed Brown   ierr = PetscMalloc1(n_local_dofs,&temp_global_dofs);CHKERRQ(ierr);
3164674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
3165674ae819SStefano Zampini   max_local = 0;
3166b9b85e73SStefano Zampini   for (i=0;i<n_local_dofs;i++) {
3167674ae819SStefano Zampini     if (max_local < temp_global_dofs[i] ) {
3168674ae819SStefano Zampini       max_local = temp_global_dofs[i];
3169674ae819SStefano Zampini     }
3170674ae819SStefano Zampini   }
3171b9b85e73SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);CHKERRQ(ierr);
3172674ae819SStefano Zampini   max_global++;
3173674ae819SStefano Zampini   max_local = 0;
3174b9b85e73SStefano Zampini   for (i=0;i<n_local_dofs;i++) {
3175674ae819SStefano Zampini     if (max_local < local_dofs[i] ) {
3176674ae819SStefano Zampini       max_local = local_dofs[i];
3177674ae819SStefano Zampini     }
3178674ae819SStefano Zampini   }
3179674ae819SStefano Zampini   max_local++;
3180674ae819SStefano Zampini   /* allocate workspace */
3181674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
3182674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
3183674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
3184674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
3185674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
3186674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
3187674ae819SStefano Zampini   /* create scatter */
3188674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
3189674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
3190674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
3191674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
3192674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
3193674ae819SStefano Zampini   /* init array */
3194674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
3195674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
3196674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
3197674ae819SStefano Zampini   if (local_dofs_mult) {
3198674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
3199674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
3200674ae819SStefano Zampini     }
3201674ae819SStefano Zampini   } else {
3202674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
3203674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
3204674ae819SStefano Zampini     }
3205674ae819SStefano Zampini   }
3206674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
3207674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
3208674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3209674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3210674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
32115b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
3212674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
3213674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
3214674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
3215674ae819SStefano Zampini   nlocals = 0;
3216674ae819SStefano Zampini   first_index = -1;
3217674ae819SStefano Zampini   first_found = PETSC_FALSE;
3218674ae819SStefano Zampini   for (i=0;i<s;i++) {
3219b9b85e73SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.1) {
3220674ae819SStefano Zampini       first_found = PETSC_TRUE;
3221674ae819SStefano Zampini       first_index = i;
3222674ae819SStefano Zampini     }
32235b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
3224674ae819SStefano Zampini   }
3225674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
3226674ae819SStefano Zampini   if (!rank_prec_comm) {
3227674ae819SStefano Zampini     dof_displs[0]=0;
3228674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
3229674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
3230674ae819SStefano Zampini     }
3231674ae819SStefano Zampini   }
3232674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
3233674ae819SStefano Zampini   if (first_found) {
3234674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
3235674ae819SStefano Zampini     old_index = first_index;
3236674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
3237b9b85e73SStefano Zampini       if (PetscRealPart(array[i]) > 0.1) {
3238674ae819SStefano Zampini         array[i] += array[old_index];
3239674ae819SStefano Zampini         old_index = i;
3240674ae819SStefano Zampini       }
3241674ae819SStefano Zampini     }
3242674ae819SStefano Zampini   }
3243674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
3244674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
3245674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3246674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3247674ae819SStefano Zampini   /* get global ordering of local dofs */
32482b095fd8SStefano Zampini   ierr = VecGetArrayRead(local_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
3249674ae819SStefano Zampini   if (local_dofs_mult) {
3250674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
32515b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
3252674ae819SStefano Zampini     }
3253674ae819SStefano Zampini   } else {
3254674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
32555b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
3256674ae819SStefano Zampini     }
3257674ae819SStefano Zampini   }
32582b095fd8SStefano Zampini   ierr = VecRestoreArrayRead(local_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
3259674ae819SStefano Zampini   /* free workspace */
3260674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
3261674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
3262674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
326317ccb9bdSStefano Zampini   ierr = PetscFree2(dof_sizes,dof_displs);CHKERRQ(ierr);
3264674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
3265674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
3266674ae819SStefano Zampini   PetscFunctionReturn(0);
3267674ae819SStefano Zampini }
32689a7d3425SStefano Zampini 
32699a7d3425SStefano Zampini #undef __FUNCT__
32709a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
32719a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
32729a7d3425SStefano Zampini {
32739a7d3425SStefano Zampini   PetscInt       i,j;
32749a7d3425SStefano Zampini   PetscScalar    *alphas;
32759a7d3425SStefano Zampini   PetscErrorCode ierr;
32769a7d3425SStefano Zampini 
32779a7d3425SStefano Zampini   PetscFunctionBegin;
32789a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
3279785e854fSJed Brown   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
32809a7d3425SStefano Zampini   for (i=0;i<n;i++) {
32819a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
32829a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
32839a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
32849a7d3425SStefano Zampini   }
32859a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
32869a7d3425SStefano Zampini   PetscFunctionReturn(0);
32879a7d3425SStefano Zampini }
32889a7d3425SStefano Zampini 
3289e7931f94SStefano Zampini #undef __FUNCT__
329070cf5478SStefano Zampini #define __FUNCT__ "MatISGetSubassemblingPattern"
329128143c3dSStefano Zampini PetscErrorCode MatISGetSubassemblingPattern(Mat mat, PetscInt n_subdomains, PetscBool contiguous, IS* is_sends)
3292e7931f94SStefano Zampini {
3293e7931f94SStefano Zampini   Mat             subdomain_adj;
3294e7931f94SStefano Zampini   IS              new_ranks,ranks_send_to;
3295e7931f94SStefano Zampini   MatPartitioning partitioner;
3296e7931f94SStefano Zampini   Mat_IS          *matis;
3297e7931f94SStefano Zampini   PetscInt        n_neighs,*neighs,*n_shared,**shared;
3298e7931f94SStefano Zampini   PetscInt        prank;
3299e7931f94SStefano Zampini   PetscMPIInt     size,rank,color;
3300e7931f94SStefano Zampini   PetscInt        *xadj,*adjncy,*oldranks;
3301e7931f94SStefano Zampini   PetscInt        *adjncy_wgt,*v_wgt,*is_indices,*ranks_send_to_idx;
33023837a79fSStefano Zampini   PetscInt        i,local_size,threshold=0;
3303e7931f94SStefano Zampini   PetscErrorCode  ierr;
33042b510759SStefano Zampini   PetscBool       use_vwgt=PETSC_FALSE,use_square=PETSC_FALSE;
3305e7931f94SStefano Zampini   PetscSubcomm    subcomm;
3306a57a6d2fSStefano Zampini 
3307e7931f94SStefano Zampini   PetscFunctionBegin;
33082b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_square",&use_square,NULL);CHKERRQ(ierr);
33092b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
33102b510759SStefano Zampini   ierr = PetscOptionsGetInt(NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
3311e7931f94SStefano Zampini 
3312e7931f94SStefano Zampini   /* Get info on mapping */
3313e7931f94SStefano Zampini   matis = (Mat_IS*)(mat->data);
3314e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&local_size);CHKERRQ(ierr);
3315e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
3316e7931f94SStefano Zampini 
3317e7931f94SStefano Zampini   /* build local CSR graph of subdomains' connectivity */
3318785e854fSJed Brown   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
3319e7931f94SStefano Zampini   xadj[0] = 0;
3320e7931f94SStefano Zampini   xadj[1] = PetscMax(n_neighs-1,0);
3321785e854fSJed Brown   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
3322785e854fSJed Brown   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
3323e7931f94SStefano Zampini 
33242b510759SStefano Zampini   if (threshold) {
3325d023bfaeSStefano Zampini     PetscInt xadj_count = 0;
33262b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
3327d023bfaeSStefano Zampini       if (n_shared[i] > threshold) {
3328d023bfaeSStefano Zampini         adjncy[xadj_count] = neighs[i];
3329d023bfaeSStefano Zampini         adjncy_wgt[xadj_count] = n_shared[i];
3330d023bfaeSStefano Zampini         xadj_count++;
3331e7931f94SStefano Zampini       }
3332e7931f94SStefano Zampini     }
3333d023bfaeSStefano Zampini     xadj[1] = xadj_count;
3334c8587f34SStefano Zampini   } else {
3335e7931f94SStefano Zampini     if (xadj[1]) {
3336e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy,&neighs[1],xadj[1]*sizeof(*adjncy));CHKERRQ(ierr);
3337e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy_wgt,&n_shared[1],xadj[1]*sizeof(*adjncy_wgt));CHKERRQ(ierr);
3338c8587f34SStefano Zampini     }
3339e7931f94SStefano Zampini   }
3340e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingRestoreInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
3341e7931f94SStefano Zampini   if (use_square) {
3342e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
3343e7931f94SStefano Zampini       adjncy_wgt[i] = adjncy_wgt[i]*adjncy_wgt[i];
3344e7931f94SStefano Zampini     }
3345e7931f94SStefano Zampini   }
3346e7931f94SStefano Zampini   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
3347e7931f94SStefano Zampini 
33483837a79fSStefano Zampini   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
3349e7931f94SStefano Zampini 
3350e7931f94SStefano Zampini   /*
3351e7931f94SStefano Zampini     Restrict work on active processes only.
3352e7931f94SStefano Zampini   */
3353e7931f94SStefano Zampini   ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&subcomm);CHKERRQ(ierr);
3354e7931f94SStefano Zampini   ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
3355e7931f94SStefano Zampini   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
33562b510759SStefano Zampini   ierr = PetscMPIIntCast(!local_size,&color);CHKERRQ(ierr);
3357d3531aaaSJed Brown   ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
3358e7931f94SStefano Zampini   if (color) {
3359e7931f94SStefano Zampini     ierr = PetscFree(xadj);CHKERRQ(ierr);
3360e7931f94SStefano Zampini     ierr = PetscFree(adjncy);CHKERRQ(ierr);
3361e7931f94SStefano Zampini     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
3362c8587f34SStefano Zampini   } else {
336328143c3dSStefano Zampini     PetscInt coarsening_ratio;
3364306c2d5bSBarry Smith     ierr = MPI_Comm_size(PetscSubcommChild(subcomm),&size);CHKERRQ(ierr);
3365785e854fSJed Brown     ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
3366e7931f94SStefano Zampini     prank = rank;
3367306c2d5bSBarry Smith     ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,PetscSubcommChild(subcomm));CHKERRQ(ierr);
33688002ef2cSStefano Zampini     /*
3369e7931f94SStefano Zampini     for (i=0;i<size;i++) {
3370e7931f94SStefano Zampini       PetscPrintf(subcomm->comm,"oldranks[%d] = %d\n",i,oldranks[i]);
3371c8587f34SStefano Zampini     }
33728002ef2cSStefano Zampini     */
3373e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
3374e7931f94SStefano Zampini       ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
3375c8587f34SStefano Zampini     }
3376e7931f94SStefano Zampini     ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
3377306c2d5bSBarry Smith     ierr = MatCreateMPIAdj(PetscSubcommChild(subcomm),1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
337822b6e8a2SStefano Zampini     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
3379e7931f94SStefano Zampini 
3380e7931f94SStefano Zampini     /* Partition */
3381306c2d5bSBarry Smith     ierr = MatPartitioningCreate(PetscSubcommChild(subcomm),&partitioner);CHKERRQ(ierr);
3382e7931f94SStefano Zampini     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
3383e7931f94SStefano Zampini     if (use_vwgt) {
33843837a79fSStefano Zampini       ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
3385e7931f94SStefano Zampini       v_wgt[0] = local_size;
3386e7931f94SStefano Zampini       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
3387c8587f34SStefano Zampini     }
338828143c3dSStefano Zampini     n_subdomains = PetscMin((PetscInt)size,n_subdomains);
338928143c3dSStefano Zampini     coarsening_ratio = size/n_subdomains;
339028143c3dSStefano Zampini     ierr = MatPartitioningSetNParts(partitioner,n_subdomains);CHKERRQ(ierr);
3391e7931f94SStefano Zampini     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
3392e7931f94SStefano Zampini     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
339322b6e8a2SStefano Zampini     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
3394e7931f94SStefano Zampini 
3395e7931f94SStefano Zampini     ierr = ISGetIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
339628143c3dSStefano Zampini     if (contiguous) {
339728143c3dSStefano Zampini       ranks_send_to_idx[0] = oldranks[is_indices[0]]; /* contiguos set of processes */
339828143c3dSStefano Zampini     } else {
339984ba6060SStefano Zampini       ranks_send_to_idx[0] = coarsening_ratio*oldranks[is_indices[0]]; /* scattered set of processes */
340028143c3dSStefano Zampini     }
3401e7931f94SStefano Zampini     ierr = ISRestoreIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
3402e7931f94SStefano Zampini     /* clean up */
3403e7931f94SStefano Zampini     ierr = PetscFree(oldranks);CHKERRQ(ierr);
3404e7931f94SStefano Zampini     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
3405e7931f94SStefano Zampini     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
3406e7931f94SStefano Zampini     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
3407e7931f94SStefano Zampini   }
3408e7931f94SStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
3409e7931f94SStefano Zampini 
3410e7931f94SStefano Zampini   /* assemble parallel IS for sends */
3411e7931f94SStefano Zampini   i = 1;
3412e7931f94SStefano Zampini   if (color) i=0;
3413e7931f94SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,&ranks_send_to);CHKERRQ(ierr);
3414e7931f94SStefano Zampini 
3415e7931f94SStefano Zampini   /* get back IS */
3416e7931f94SStefano Zampini   *is_sends = ranks_send_to;
3417e7931f94SStefano Zampini   PetscFunctionReturn(0);
3418e7931f94SStefano Zampini }
3419e7931f94SStefano Zampini 
3420e7931f94SStefano Zampini typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
3421e7931f94SStefano Zampini 
3422e7931f94SStefano Zampini #undef __FUNCT__
3423e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble"
342428143c3dSStefano Zampini PetscErrorCode MatISSubassemble(Mat mat, IS is_sends, PetscInt n_subdomains, PetscBool restrict_comm, MatReuse reuse, Mat *mat_n, PetscInt nis, IS isarray[])
3425e7931f94SStefano Zampini {
342670cf5478SStefano Zampini   Mat                    local_mat;
3427e7931f94SStefano Zampini   Mat_IS                 *matis;
3428e7931f94SStefano Zampini   IS                     is_sends_internal;
34299d30be91SStefano Zampini   PetscInt               rows,cols,new_local_rows;
343028143c3dSStefano Zampini   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals;
34319d30be91SStefano Zampini   PetscBool              ismatis,isdense,newisdense,destroy_mat;
3432e7931f94SStefano Zampini   ISLocalToGlobalMapping l2gmap;
3433e7931f94SStefano Zampini   PetscInt*              l2gmap_indices;
3434e7931f94SStefano Zampini   const PetscInt*        is_indices;
3435e7931f94SStefano Zampini   MatType                new_local_type;
3436e7931f94SStefano Zampini   /* buffers */
3437e7931f94SStefano Zampini   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
343828143c3dSStefano Zampini   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
34399d30be91SStefano Zampini   PetscInt               *recv_buffer_idxs_local;
3440e7931f94SStefano Zampini   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
3441e7931f94SStefano Zampini   /* MPI */
344228143c3dSStefano Zampini   MPI_Comm               comm,comm_n;
344328143c3dSStefano Zampini   PetscSubcomm           subcomm;
3444e7931f94SStefano Zampini   PetscMPIInt            n_sends,n_recvs,commsize;
344528143c3dSStefano Zampini   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
344628143c3dSStefano Zampini   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
344728143c3dSStefano Zampini   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,source_dest;
344828143c3dSStefano Zampini   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals;
344928143c3dSStefano Zampini   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals;
3450e7931f94SStefano Zampini   PetscErrorCode         ierr;
3451e7931f94SStefano Zampini 
3452e7931f94SStefano Zampini   PetscFunctionBegin;
345328143c3dSStefano Zampini   /* TODO: add missing checks */
345428143c3dSStefano Zampini   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
345528143c3dSStefano Zampini   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
345628143c3dSStefano Zampini   PetscValidLogicalCollectiveEnum(mat,reuse,5);
345728143c3dSStefano Zampini   PetscValidLogicalCollectiveInt(mat,nis,7);
3458e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
345928143c3dSStefano Zampini   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",__FUNCT__);
3460e7931f94SStefano Zampini   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
3461e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
3462e7931f94SStefano Zampini   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
3463e7931f94SStefano Zampini   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
3464e7931f94SStefano Zampini   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
346528143c3dSStefano Zampini   if (reuse == MAT_REUSE_MATRIX && *mat_n) {
346670cf5478SStefano Zampini     PetscInt mrows,mcols,mnrows,mncols;
346770cf5478SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
346828143c3dSStefano Zampini     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
346970cf5478SStefano Zampini     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
347070cf5478SStefano Zampini     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
347170cf5478SStefano Zampini     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
347270cf5478SStefano Zampini     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
347370cf5478SStefano Zampini   }
3474e7931f94SStefano Zampini   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
3475e7931f94SStefano Zampini   PetscValidLogicalCollectiveInt(mat,bs,0);
3476e7931f94SStefano Zampini   /* prepare IS for sending if not provided */
3477e7931f94SStefano Zampini   if (!is_sends) {
347828143c3dSStefano Zampini     PetscBool pcontig = PETSC_TRUE;
347928143c3dSStefano Zampini     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
348028143c3dSStefano Zampini     ierr = MatISGetSubassemblingPattern(mat,n_subdomains,pcontig,&is_sends_internal);CHKERRQ(ierr);
3481c8587f34SStefano Zampini   } else {
3482e7931f94SStefano Zampini     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
3483e7931f94SStefano Zampini     is_sends_internal = is_sends;
3484c8587f34SStefano Zampini   }
3485e7931f94SStefano Zampini 
3486e7931f94SStefano Zampini   /* get pointer of MATIS data */
3487e7931f94SStefano Zampini   matis = (Mat_IS*)mat->data;
3488e7931f94SStefano Zampini 
3489e7931f94SStefano Zampini   /* get comm */
3490a316fed8SStefano Zampini   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
3491e7931f94SStefano Zampini 
3492e7931f94SStefano Zampini   /* compute number of sends */
3493e7931f94SStefano Zampini   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
3494e7931f94SStefano Zampini   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
3495e7931f94SStefano Zampini 
3496e7931f94SStefano Zampini   /* compute number of receives */
3497e7931f94SStefano Zampini   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
3498785e854fSJed Brown   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
3499e7931f94SStefano Zampini   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
3500e7931f94SStefano Zampini   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
3501e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
3502e7931f94SStefano Zampini   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
3503e7931f94SStefano Zampini   ierr = PetscFree(iflags);CHKERRQ(ierr);
3504e7931f94SStefano Zampini 
350528143c3dSStefano Zampini   /* restrict comm if requested */
350628143c3dSStefano Zampini   subcomm = 0;
350728143c3dSStefano Zampini   destroy_mat = PETSC_FALSE;
350828143c3dSStefano Zampini   if (restrict_comm) {
3509779c1cceSStefano Zampini     PetscMPIInt color,subcommsize;
3510779c1cceSStefano Zampini 
351128143c3dSStefano Zampini     color = 0;
3512779c1cceSStefano Zampini     if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm */
351328143c3dSStefano Zampini     ierr = MPI_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
351428143c3dSStefano Zampini     subcommsize = commsize - subcommsize;
351528143c3dSStefano Zampini     /* check if reuse has been requested */
351628143c3dSStefano Zampini     if (reuse == MAT_REUSE_MATRIX) {
351728143c3dSStefano Zampini       if (*mat_n) {
351828143c3dSStefano Zampini         PetscMPIInt subcommsize2;
351928143c3dSStefano Zampini         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
352028143c3dSStefano Zampini         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
352128143c3dSStefano Zampini         comm_n = PetscObjectComm((PetscObject)*mat_n);
352228143c3dSStefano Zampini       } else {
352328143c3dSStefano Zampini         comm_n = PETSC_COMM_SELF;
352428143c3dSStefano Zampini       }
352528143c3dSStefano Zampini     } else { /* MAT_INITIAL_MATRIX */
3526779c1cceSStefano Zampini       PetscMPIInt rank;
3527779c1cceSStefano Zampini 
3528779c1cceSStefano Zampini       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
352928143c3dSStefano Zampini       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
353028143c3dSStefano Zampini       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
353128143c3dSStefano Zampini       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
3532306c2d5bSBarry Smith       comm_n = PetscSubcommChild(subcomm);
353328143c3dSStefano Zampini     }
353428143c3dSStefano Zampini     /* flag to destroy *mat_n if not significative */
353528143c3dSStefano Zampini     if (color) destroy_mat = PETSC_TRUE;
353628143c3dSStefano Zampini   } else {
353728143c3dSStefano Zampini     comm_n = comm;
353828143c3dSStefano Zampini   }
353928143c3dSStefano Zampini 
3540e7931f94SStefano Zampini   /* prepare send/receive buffers */
3541785e854fSJed Brown   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
3542e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
3543785e854fSJed Brown   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
3544e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
354528143c3dSStefano Zampini   if (nis) {
3546854ce69bSBarry Smith     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
354728143c3dSStefano Zampini   }
3548e7931f94SStefano Zampini 
354928143c3dSStefano Zampini   /* Get data from local matrices */
3550e7931f94SStefano Zampini   if (!isdense) {
3551a26c9d0eSStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
3552e7931f94SStefano Zampini     /* TODO: See below some guidelines on how to prepare the local buffers */
3553e7931f94SStefano Zampini     /*
3554e7931f94SStefano Zampini        send_buffer_vals should contain the raw values of the local matrix
3555e7931f94SStefano Zampini        send_buffer_idxs should contain:
3556e7931f94SStefano Zampini        - MatType_PRIVATE type
3557e7931f94SStefano Zampini        - PetscInt        size_of_l2gmap
3558e7931f94SStefano Zampini        - PetscInt        global_row_indices[size_of_l2gmap]
3559e7931f94SStefano Zampini        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
3560e7931f94SStefano Zampini     */
3561e7931f94SStefano Zampini   } else {
3562e7931f94SStefano Zampini     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
3563e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&i);CHKERRQ(ierr);
3564854ce69bSBarry Smith     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
3565e7931f94SStefano Zampini     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
3566e7931f94SStefano Zampini     send_buffer_idxs[1] = i;
3567e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
3568e7931f94SStefano Zampini     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
3569e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingRestoreIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
3570e7931f94SStefano Zampini     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
3571e7931f94SStefano Zampini     for (i=0;i<n_sends;i++) {
3572e7931f94SStefano Zampini       ilengths_vals[is_indices[i]] = len*len;
3573e7931f94SStefano Zampini       ilengths_idxs[is_indices[i]] = len+2;
3574c8587f34SStefano Zampini     }
3575c8587f34SStefano Zampini   }
3576e7931f94SStefano Zampini   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
357728143c3dSStefano Zampini   /* additional is (if any) */
357828143c3dSStefano Zampini   if (nis) {
357928143c3dSStefano Zampini     PetscMPIInt psum;
358028143c3dSStefano Zampini     PetscInt j;
358128143c3dSStefano Zampini     for (j=0,psum=0;j<nis;j++) {
358228143c3dSStefano Zampini       PetscInt plen;
358328143c3dSStefano Zampini       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
358428143c3dSStefano Zampini       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
358528143c3dSStefano Zampini       psum += len+1; /* indices + lenght */
358628143c3dSStefano Zampini     }
3587854ce69bSBarry Smith     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
358828143c3dSStefano Zampini     for (j=0,psum=0;j<nis;j++) {
358928143c3dSStefano Zampini       PetscInt plen;
359028143c3dSStefano Zampini       const PetscInt *is_array_idxs;
359128143c3dSStefano Zampini       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
359228143c3dSStefano Zampini       send_buffer_idxs_is[psum] = plen;
359328143c3dSStefano Zampini       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
359428143c3dSStefano Zampini       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
359528143c3dSStefano Zampini       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
359628143c3dSStefano Zampini       psum += plen+1; /* indices + lenght */
359728143c3dSStefano Zampini     }
359828143c3dSStefano Zampini     for (i=0;i<n_sends;i++) {
359928143c3dSStefano Zampini       ilengths_idxs_is[is_indices[i]] = psum;
360028143c3dSStefano Zampini     }
360128143c3dSStefano Zampini     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
360228143c3dSStefano Zampini   }
360328143c3dSStefano Zampini 
3604e7931f94SStefano Zampini   buf_size_idxs = 0;
3605e7931f94SStefano Zampini   buf_size_vals = 0;
360628143c3dSStefano Zampini   buf_size_idxs_is = 0;
3607e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3608e7931f94SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
3609e7931f94SStefano Zampini     buf_size_vals += (PetscInt)olengths_vals[i];
361028143c3dSStefano Zampini     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
3611e7931f94SStefano Zampini   }
3612785e854fSJed Brown   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
3613785e854fSJed Brown   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
361495ecbf38SStefano Zampini   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
3615e7931f94SStefano Zampini 
3616e7931f94SStefano Zampini   /* get new tags for clean communications */
3617e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
3618e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
361928143c3dSStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
3620e7931f94SStefano Zampini 
3621e7931f94SStefano Zampini   /* allocate for requests */
3622785e854fSJed Brown   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
3623785e854fSJed Brown   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
362495ecbf38SStefano Zampini   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
3625785e854fSJed Brown   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
3626785e854fSJed Brown   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
362795ecbf38SStefano Zampini   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
3628e7931f94SStefano Zampini 
3629e7931f94SStefano Zampini   /* communications */
3630e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
3631e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
363228143c3dSStefano Zampini   ptr_idxs_is = recv_buffer_idxs_is;
3633e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3634e7931f94SStefano Zampini     source_dest = onodes[i];
3635e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
3636e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
3637e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3638e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
363928143c3dSStefano Zampini     if (nis) {
364028143c3dSStefano 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);
364128143c3dSStefano Zampini       ptr_idxs_is += olengths_idxs_is[i];
364228143c3dSStefano Zampini     }
3643e7931f94SStefano Zampini   }
3644e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) {
3645e7931f94SStefano Zampini     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
3646e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
3647e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
364828143c3dSStefano Zampini     if (nis) {
364928143c3dSStefano 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);
365028143c3dSStefano Zampini     }
3651e7931f94SStefano Zampini   }
3652e7931f94SStefano Zampini   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
3653e7931f94SStefano Zampini   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
3654e7931f94SStefano Zampini 
3655e7931f94SStefano Zampini   /* assemble new l2g map */
3656e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3657e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
36589d30be91SStefano Zampini   new_local_rows = 0;
3659e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
36609d30be91SStefano Zampini     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
3661e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3662e7931f94SStefano Zampini   }
36639d30be91SStefano Zampini   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
3664e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
36659d30be91SStefano Zampini   new_local_rows = 0;
3666e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
36679d30be91SStefano Zampini     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
36689d30be91SStefano Zampini     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
3669e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3670e7931f94SStefano Zampini   }
36719d30be91SStefano Zampini   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
36729d30be91SStefano Zampini   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
3673e7931f94SStefano Zampini   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
3674e7931f94SStefano Zampini 
3675e7931f94SStefano Zampini   /* infer new local matrix type from received local matrices type */
3676e7931f94SStefano Zampini   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
3677e7931f94SStefano 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) */
3678e7931f94SStefano Zampini   if (n_recvs) {
367928143c3dSStefano Zampini     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
3680e7931f94SStefano Zampini     ptr_idxs = recv_buffer_idxs;
3681e7931f94SStefano Zampini     for (i=0;i<n_recvs;i++) {
3682e7931f94SStefano Zampini       if ((PetscInt)new_local_type_private != *ptr_idxs) {
3683e7931f94SStefano Zampini         new_local_type_private = MATAIJ_PRIVATE;
3684e7931f94SStefano Zampini         break;
3685e7931f94SStefano Zampini       }
3686e7931f94SStefano Zampini       ptr_idxs += olengths_idxs[i];
3687e7931f94SStefano Zampini     }
3688e7931f94SStefano Zampini     switch (new_local_type_private) {
368928143c3dSStefano Zampini       case MATDENSE_PRIVATE:
369028143c3dSStefano Zampini         if (n_recvs>1) { /* subassembling of dense matrices does not give a dense matrix! */
3691e7931f94SStefano Zampini           new_local_type = MATSEQAIJ;
3692e7931f94SStefano Zampini           bs = 1;
369328143c3dSStefano Zampini         } else { /* if I receive only 1 dense matrix */
369428143c3dSStefano Zampini           new_local_type = MATSEQDENSE;
369528143c3dSStefano Zampini           bs = 1;
369628143c3dSStefano Zampini         }
3697e7931f94SStefano Zampini         break;
3698e7931f94SStefano Zampini       case MATAIJ_PRIVATE:
3699e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
3700e7931f94SStefano Zampini         bs = 1;
3701e7931f94SStefano Zampini         break;
3702e7931f94SStefano Zampini       case MATBAIJ_PRIVATE:
3703e7931f94SStefano Zampini         new_local_type = MATSEQBAIJ;
3704e7931f94SStefano Zampini         break;
3705e7931f94SStefano Zampini       case MATSBAIJ_PRIVATE:
3706e7931f94SStefano Zampini         new_local_type = MATSEQSBAIJ;
3707e7931f94SStefano Zampini         break;
3708e7931f94SStefano Zampini       default:
37099d30be91SStefano Zampini         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,__FUNCT__);
3710e7931f94SStefano Zampini         break;
3711e7931f94SStefano Zampini     }
371228143c3dSStefano Zampini   } else { /* by default, new_local_type is seqdense */
371328143c3dSStefano Zampini     new_local_type = MATSEQDENSE;
371428143c3dSStefano Zampini     bs = 1;
3715e7931f94SStefano Zampini   }
3716e7931f94SStefano Zampini 
371770cf5478SStefano Zampini   /* create MATIS object if needed */
371870cf5478SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
3719e7931f94SStefano Zampini     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
372028143c3dSStefano Zampini     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,mat_n);CHKERRQ(ierr);
372170cf5478SStefano Zampini   } else {
372270cf5478SStefano Zampini     /* it also destroys the local matrices */
372370cf5478SStefano Zampini     ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
372470cf5478SStefano Zampini   }
372570cf5478SStefano Zampini   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
3726e7931f94SStefano Zampini   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
37279d30be91SStefano Zampini 
37289d30be91SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
37299d30be91SStefano Zampini 
37309d30be91SStefano Zampini   /* Global to local map of received indices */
37319d30be91SStefano Zampini   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
37329d30be91SStefano Zampini   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
37339d30be91SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
37349d30be91SStefano Zampini 
37359d30be91SStefano Zampini   /* restore attributes -> type of incoming data and its size */
37369d30be91SStefano Zampini   buf_size_idxs = 0;
37379d30be91SStefano Zampini   for (i=0;i<n_recvs;i++) {
37389d30be91SStefano Zampini     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
37399d30be91SStefano Zampini     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
37409d30be91SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
37419d30be91SStefano Zampini   }
37429d30be91SStefano Zampini   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
37439d30be91SStefano Zampini 
37449d30be91SStefano Zampini   /* set preallocation */
37459d30be91SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
37469d30be91SStefano Zampini   if (!newisdense) {
37479d30be91SStefano Zampini     PetscInt *new_local_nnz=0;
37489d30be91SStefano Zampini 
37499d30be91SStefano Zampini     ptr_vals = recv_buffer_vals;
37509d30be91SStefano Zampini     ptr_idxs = recv_buffer_idxs_local;
37519d30be91SStefano Zampini     if (n_recvs) {
37529d30be91SStefano Zampini       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
37539d30be91SStefano Zampini     }
37549d30be91SStefano Zampini     for (i=0;i<n_recvs;i++) {
37559d30be91SStefano Zampini       PetscInt j;
37569d30be91SStefano Zampini       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
37579d30be91SStefano Zampini         for (j=0;j<*(ptr_idxs+1);j++) {
37589d30be91SStefano Zampini           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
37599d30be91SStefano Zampini         }
37609d30be91SStefano Zampini       } else {
37619d30be91SStefano Zampini         /* TODO */
37629d30be91SStefano Zampini       }
37639d30be91SStefano Zampini       ptr_idxs += olengths_idxs[i];
37649d30be91SStefano Zampini     }
37659d30be91SStefano Zampini     if (new_local_nnz) {
37669d30be91SStefano Zampini       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
37679d30be91SStefano Zampini       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
37689d30be91SStefano Zampini       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
37699d30be91SStefano Zampini       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
37709d30be91SStefano Zampini       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
37719d30be91SStefano Zampini       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
37729d30be91SStefano Zampini     } else {
37739d30be91SStefano Zampini       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
37749d30be91SStefano Zampini     }
37759d30be91SStefano Zampini     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
37769d30be91SStefano Zampini   } else {
37779d30be91SStefano Zampini     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
37789d30be91SStefano Zampini   }
3779e7931f94SStefano Zampini 
3780e7931f94SStefano Zampini   /* set values */
3781e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
37829d30be91SStefano Zampini   ptr_idxs = recv_buffer_idxs_local;
3783e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3784e7931f94SStefano Zampini     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
3785e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
37869d30be91SStefano Zampini       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
3787e7931f94SStefano Zampini       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3788e7931f94SStefano Zampini       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3789e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
379028143c3dSStefano Zampini     } else {
379128143c3dSStefano Zampini       /* TODO */
3792e7931f94SStefano Zampini     }
3793e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3794e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
3795e7931f94SStefano Zampini   }
3796e7931f94SStefano Zampini   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3797e7931f94SStefano Zampini   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
379870cf5478SStefano Zampini   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
379970cf5478SStefano Zampini   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
38009d30be91SStefano Zampini   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
38019d30be91SStefano Zampini   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
3802e7931f94SStefano Zampini 
3803dfd14d43SStefano Zampini #if 0
380428143c3dSStefano Zampini   if (!restrict_comm) { /* check */
3805e7931f94SStefano Zampini     Vec       lvec,rvec;
3806e7931f94SStefano Zampini     PetscReal infty_error;
3807e7931f94SStefano Zampini 
38082a7a6963SBarry Smith     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
3809e7931f94SStefano Zampini     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
3810e7931f94SStefano Zampini     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
3811e7931f94SStefano Zampini     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
381270cf5478SStefano Zampini     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
3813e7931f94SStefano Zampini     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3814e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
3815e7931f94SStefano Zampini     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
3816e7931f94SStefano Zampini     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
3817e7931f94SStefano Zampini   }
381828143c3dSStefano Zampini #endif
3819e7931f94SStefano Zampini 
382028143c3dSStefano Zampini   /* assemble new additional is (if any) */
382128143c3dSStefano Zampini   if (nis) {
382228143c3dSStefano Zampini     PetscInt **temp_idxs,*count_is,j,psum;
382328143c3dSStefano Zampini 
382428143c3dSStefano Zampini     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3825854ce69bSBarry Smith     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
382628143c3dSStefano Zampini     ptr_idxs = recv_buffer_idxs_is;
382728143c3dSStefano Zampini     psum = 0;
382828143c3dSStefano Zampini     for (i=0;i<n_recvs;i++) {
382928143c3dSStefano Zampini       for (j=0;j<nis;j++) {
383028143c3dSStefano Zampini         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
383128143c3dSStefano Zampini         count_is[j] += plen; /* increment counting of buffer for j-th IS */
383228143c3dSStefano Zampini         psum += plen;
383328143c3dSStefano Zampini         ptr_idxs += plen+1; /* shift pointer to received data */
383428143c3dSStefano Zampini       }
383528143c3dSStefano Zampini     }
3836854ce69bSBarry Smith     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
3837854ce69bSBarry Smith     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
383828143c3dSStefano Zampini     for (i=1;i<nis;i++) {
383928143c3dSStefano Zampini       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
384028143c3dSStefano Zampini     }
384128143c3dSStefano Zampini     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
384228143c3dSStefano Zampini     ptr_idxs = recv_buffer_idxs_is;
384328143c3dSStefano Zampini     for (i=0;i<n_recvs;i++) {
384428143c3dSStefano Zampini       for (j=0;j<nis;j++) {
384528143c3dSStefano Zampini         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
384628143c3dSStefano Zampini         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
384728143c3dSStefano Zampini         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
384828143c3dSStefano Zampini         ptr_idxs += plen+1; /* shift pointer to received data */
384928143c3dSStefano Zampini       }
385028143c3dSStefano Zampini     }
385128143c3dSStefano Zampini     for (i=0;i<nis;i++) {
385228143c3dSStefano Zampini       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
385328143c3dSStefano Zampini       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
385428143c3dSStefano Zampini       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
385528143c3dSStefano Zampini     }
385628143c3dSStefano Zampini     ierr = PetscFree(count_is);CHKERRQ(ierr);
385728143c3dSStefano Zampini     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
385828143c3dSStefano Zampini     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
385928143c3dSStefano Zampini   }
3860e7931f94SStefano Zampini   /* free workspace */
386128143c3dSStefano Zampini   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
3862e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3863e7931f94SStefano Zampini   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
3864e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3865e7931f94SStefano Zampini   if (isdense) {
3866e7931f94SStefano Zampini     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
3867e7931f94SStefano Zampini     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
3868e7931f94SStefano Zampini   } else {
3869e7931f94SStefano Zampini     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
3870e7931f94SStefano Zampini   }
387128143c3dSStefano Zampini   if (nis) {
387228143c3dSStefano Zampini     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
387328143c3dSStefano Zampini     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
387428143c3dSStefano Zampini   }
3875e7931f94SStefano Zampini   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
3876e7931f94SStefano Zampini   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
387728143c3dSStefano Zampini   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
3878e7931f94SStefano Zampini   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
3879e7931f94SStefano Zampini   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
388028143c3dSStefano Zampini   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
3881e7931f94SStefano Zampini   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
3882e7931f94SStefano Zampini   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
3883e7931f94SStefano Zampini   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
3884e7931f94SStefano Zampini   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
3885e7931f94SStefano Zampini   ierr = PetscFree(onodes);CHKERRQ(ierr);
388628143c3dSStefano Zampini   if (nis) {
388728143c3dSStefano Zampini     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
388828143c3dSStefano Zampini     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
388928143c3dSStefano Zampini     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
389028143c3dSStefano Zampini   }
389128143c3dSStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
389228143c3dSStefano Zampini   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
389328143c3dSStefano Zampini     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
389428143c3dSStefano Zampini     for (i=0;i<nis;i++) {
389528143c3dSStefano Zampini       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
389628143c3dSStefano Zampini     }
389728143c3dSStefano Zampini   }
3898e7931f94SStefano Zampini   PetscFunctionReturn(0);
3899e7931f94SStefano Zampini }
3900a57a6d2fSStefano Zampini 
390112edc857SStefano Zampini /* temporary hack into ksp private data structure */
3902af0996ceSBarry Smith #include <petsc/private/kspimpl.h>
390312edc857SStefano Zampini 
3904c8587f34SStefano Zampini #undef __FUNCT__
3905c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
3906c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
3907c8587f34SStefano Zampini {
3908c8587f34SStefano Zampini   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
3909c8587f34SStefano Zampini   PC_IS                  *pcis = (PC_IS*)pc->data;
391020a2ab83SStefano Zampini   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
39119881197aSStefano Zampini   MatNullSpace           CoarseNullSpace=NULL;
391220a2ab83SStefano Zampini   ISLocalToGlobalMapping coarse_islg;
39136e683305SStefano Zampini   IS                     coarse_is,*isarray;
39146e683305SStefano Zampini   PetscInt               i,im_active=-1,active_procs=-1;
39156e683305SStefano Zampini   PetscInt               nis,nisdofs,nisneu;
3916f9eb5b7dSStefano Zampini   PC                     pc_temp;
3917c8587f34SStefano Zampini   PCType                 coarse_pc_type;
3918c8587f34SStefano Zampini   KSPType                coarse_ksp_type;
3919f9eb5b7dSStefano Zampini   PetscBool              multilevel_requested,multilevel_allowed;
39204f3a063dSStefano Zampini   PetscBool              isredundant,isbddc,isnn,coarse_reuse;
39216e683305SStefano Zampini   Mat                    t_coarse_mat_is;
39226e683305SStefano Zampini   PetscInt               void_procs,ncoarse_ml,ncoarse_ds,ncoarse;
39236e683305SStefano Zampini   PetscMPIInt            all_procs;
392474e2c79eSStefano Zampini   PetscBool              csin_ml,csin_ds,csin,csin_type_simple,redist;
392568457ee5SStefano Zampini   PetscBool              compute_vecs = PETSC_FALSE;
392622bc73bbSStefano Zampini   PetscScalar            *array;
39279881197aSStefano Zampini   PetscErrorCode         ierr;
3928fdc09c96SStefano Zampini 
3929c8587f34SStefano Zampini   PetscFunctionBegin;
3930c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
393168457ee5SStefano 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 */
3932fa7f1dd8SStefano Zampini     PetscInt ocoarse_size;
39335a75c04eSSatish Balay     compute_vecs = PETSC_TRUE;
3934fa7f1dd8SStefano Zampini     ocoarse_size = pcbddc->coarse_size;
3935f4ddd8eeSStefano Zampini     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3936f4ddd8eeSStefano Zampini     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
3937f4ddd8eeSStefano Zampini     /* see if we can avoid some work */
3938fa7f1dd8SStefano Zampini     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
3939fa7f1dd8SStefano Zampini       if (ocoarse_size != pcbddc->coarse_size) { /* ...but with different size, so reset it and set reuse flag to false */
3940727cdba6SStefano Zampini         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3941fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_FALSE;
3942fa7f1dd8SStefano Zampini       } else { /* we can safely reuse already computed coarse matrix */
3943fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_TRUE;
3944f4ddd8eeSStefano Zampini       }
3945fa7f1dd8SStefano Zampini     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
3946fa7f1dd8SStefano Zampini       coarse_reuse = PETSC_FALSE;
3947f4ddd8eeSStefano Zampini     }
394870cf5478SStefano Zampini     /* reset any subassembling information */
394970cf5478SStefano Zampini     ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
39506e683305SStefano Zampini     ierr = ISDestroy(&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
39516e683305SStefano Zampini   } else { /* primal space is unchanged, so we can reuse coarse matrix */
3952fa7f1dd8SStefano Zampini     coarse_reuse = PETSC_TRUE;
3953f4ddd8eeSStefano Zampini   }
3954c8587f34SStefano Zampini 
39556e683305SStefano Zampini   /* count "active" (i.e. with positive local size) and "void" processes */
39562b510759SStefano Zampini   im_active = !!(pcis->n);
39572b510759SStefano Zampini   ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
39586e683305SStefano Zampini   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&all_procs);CHKERRQ(ierr);
39596e683305SStefano Zampini   void_procs = all_procs-active_procs;
39606e683305SStefano Zampini   csin_type_simple = PETSC_TRUE;
396174e2c79eSStefano Zampini   redist = PETSC_FALSE;
396222bc73bbSStefano Zampini   if (pcbddc->current_level && void_procs) {
39636e683305SStefano Zampini     csin_ml = PETSC_TRUE;
39646e683305SStefano Zampini     ncoarse_ml = void_procs;
3965779c1cceSStefano Zampini     /* it has no sense to redistribute on a set of processors larger than the number of active processes */
3966779c1cceSStefano Zampini     if (pcbddc->redistribute_coarse > 0 && pcbddc->redistribute_coarse < active_procs) {
396718a45a71SStefano Zampini       csin_ds = PETSC_TRUE;
396818a45a71SStefano Zampini       ncoarse_ds = pcbddc->redistribute_coarse;
396918a45a71SStefano Zampini       redist = PETSC_TRUE;
397018a45a71SStefano Zampini     } else {
39716e683305SStefano Zampini       csin_ds = PETSC_TRUE;
3972779c1cceSStefano Zampini       ncoarse_ds = active_procs;
3973779c1cceSStefano Zampini       redist = PETSC_TRUE;
397418a45a71SStefano Zampini     }
39756e683305SStefano Zampini   } else {
39766e683305SStefano Zampini     csin_ml = PETSC_FALSE;
39776e683305SStefano Zampini     ncoarse_ml = all_procs;
39786e683305SStefano Zampini     if (void_procs) {
39796e683305SStefano Zampini       csin_ds = PETSC_TRUE;
39806e683305SStefano Zampini       ncoarse_ds = void_procs;
39816e683305SStefano Zampini       csin_type_simple = PETSC_FALSE;
39826e683305SStefano Zampini     } else {
3983779c1cceSStefano Zampini       if (pcbddc->redistribute_coarse > 0 && pcbddc->redistribute_coarse < all_procs) {
398474e2c79eSStefano Zampini         csin_ds = PETSC_TRUE;
398574e2c79eSStefano Zampini         ncoarse_ds = pcbddc->redistribute_coarse;
398674e2c79eSStefano Zampini         redist = PETSC_TRUE;
398774e2c79eSStefano Zampini       } else {
39886e683305SStefano Zampini         csin_ds = PETSC_FALSE;
39896e683305SStefano Zampini         ncoarse_ds = all_procs;
39906e683305SStefano Zampini       }
39916e683305SStefano Zampini     }
399274e2c79eSStefano Zampini   }
39936e683305SStefano Zampini 
39946e683305SStefano Zampini   /*
39956e683305SStefano Zampini     test if we can go multilevel: three conditions must be satisfied:
39966e683305SStefano Zampini     - we have not exceeded the number of levels requested
39976e683305SStefano Zampini     - we can actually subassemble the active processes
39986e683305SStefano Zampini     - we can find a suitable number of MPI processes where we can place the subassembled problem
39996e683305SStefano Zampini   */
40006e683305SStefano Zampini   multilevel_allowed = PETSC_FALSE;
40016e683305SStefano Zampini   multilevel_requested = PETSC_FALSE;
40026e683305SStefano Zampini   if (pcbddc->current_level < pcbddc->max_levels) {
40036e683305SStefano Zampini     multilevel_requested = PETSC_TRUE;
40046e683305SStefano Zampini     if (active_procs/pcbddc->coarsening_ratio < 2 || ncoarse_ml/pcbddc->coarsening_ratio < 2) {
4005f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_FALSE;
40062b510759SStefano Zampini     } else {
4007f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_TRUE;
4008c8587f34SStefano Zampini     }
4009c8587f34SStefano Zampini   }
40106e683305SStefano Zampini   /* determine number of process partecipating to coarse solver */
40116e683305SStefano Zampini   if (multilevel_allowed) {
40126e683305SStefano Zampini     ncoarse = ncoarse_ml;
40136e683305SStefano Zampini     csin = csin_ml;
401458da7f69SStefano Zampini     redist = PETSC_FALSE;
40156e683305SStefano Zampini   } else {
40166e683305SStefano Zampini     ncoarse = ncoarse_ds;
40176e683305SStefano Zampini     csin = csin_ds;
40186e683305SStefano Zampini   }
4019e7931f94SStefano Zampini 
4020abbbba34SStefano Zampini   /* creates temporary l2gmap and IS for coarse indexes */
4021abbbba34SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
4022abbbba34SStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
4023abbbba34SStefano Zampini 
4024abbbba34SStefano Zampini   /* creates temporary MATIS object for coarse matrix */
402522bc73bbSStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
402622bc73bbSStefano Zampini   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
402722bc73bbSStefano Zampini   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
402822bc73bbSStefano Zampini   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
4029b9b85e73SStefano Zampini #if 0
4030b9b85e73SStefano Zampini   {
4031b9b85e73SStefano Zampini     PetscViewer viewer;
4032b9b85e73SStefano Zampini     char filename[256];
4033b9b85e73SStefano Zampini     sprintf(filename,"local_coarse_mat%d.m",PetscGlobalRank);
4034b9b85e73SStefano Zampini     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4035b9b85e73SStefano Zampini     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4036b9b85e73SStefano Zampini     ierr = MatView(coarse_submat_dense,viewer);CHKERRQ(ierr);
4037b9b85e73SStefano Zampini     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4038b9b85e73SStefano Zampini   }
4039b9b85e73SStefano Zampini #endif
40406e683305SStefano 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);
40416e683305SStefano Zampini   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
40426e683305SStefano Zampini   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
40436e683305SStefano Zampini   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4044abbbba34SStefano Zampini   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
4045abbbba34SStefano Zampini 
40466e683305SStefano Zampini   /* compute dofs splitting and neumann boundaries for coarse dofs */
40476e683305SStefano Zampini   if (multilevel_allowed && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal) ) { /* protects from unneded computations */
40486e683305SStefano Zampini     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
40496e683305SStefano Zampini     const PetscInt         *idxs;
40506e683305SStefano Zampini     ISLocalToGlobalMapping tmap;
40516e683305SStefano Zampini 
40526e683305SStefano Zampini     /* create map between primal indices (in local representative ordering) and local primal numbering */
40530be93d54SStefano Zampini     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
40546e683305SStefano Zampini     /* allocate space for temporary storage */
4055854ce69bSBarry Smith     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
4056854ce69bSBarry Smith     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
40576e683305SStefano Zampini     /* allocate for IS array */
40586e683305SStefano Zampini     nisdofs = pcbddc->n_ISForDofsLocal;
40596e683305SStefano Zampini     nisneu = !!pcbddc->NeumannBoundariesLocal;
40606e683305SStefano Zampini     nis = nisdofs + nisneu;
4061854ce69bSBarry Smith     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
40626e683305SStefano Zampini     /* dofs splitting */
40636e683305SStefano Zampini     for (i=0;i<nisdofs;i++) {
40646e683305SStefano Zampini       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
40656e683305SStefano Zampini       ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
40666e683305SStefano Zampini       ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
40676e683305SStefano Zampini       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
40686e683305SStefano Zampini       ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
40696e683305SStefano Zampini       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
40706e683305SStefano Zampini       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pcbddc->ISForDofsLocal[i]),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
40716e683305SStefano Zampini       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
40726e683305SStefano Zampini     }
40736e683305SStefano Zampini     /* neumann boundaries */
40746e683305SStefano Zampini     if (pcbddc->NeumannBoundariesLocal) {
40756e683305SStefano Zampini       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
40766e683305SStefano Zampini       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
40776e683305SStefano Zampini       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
40786e683305SStefano Zampini       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
40796e683305SStefano Zampini       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
40806e683305SStefano Zampini       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
40816e683305SStefano Zampini       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pcbddc->NeumannBoundariesLocal),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
40826e683305SStefano Zampini       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
40836e683305SStefano Zampini     }
40846e683305SStefano Zampini     /* free memory */
40856e683305SStefano Zampini     ierr = PetscFree(tidxs);CHKERRQ(ierr);
40866e683305SStefano Zampini     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
40876e683305SStefano Zampini     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
40886e683305SStefano Zampini   } else {
40896e683305SStefano Zampini     nis = 0;
40906e683305SStefano Zampini     nisdofs = 0;
40916e683305SStefano Zampini     nisneu = 0;
40926e683305SStefano Zampini     isarray = NULL;
40936e683305SStefano Zampini   }
40946e683305SStefano Zampini   /* destroy no longer needed map */
40956e683305SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
40966e683305SStefano Zampini 
40976e683305SStefano Zampini   /* restrict on coarse candidates (if needed) */
40986e683305SStefano Zampini   coarse_mat_is = NULL;
40996e683305SStefano Zampini   if (csin) {
41006e683305SStefano Zampini     if (!pcbddc->coarse_subassembling_init ) { /* creates subassembling init pattern if not present */
410174e2c79eSStefano Zampini       if (redist) {
410274e2c79eSStefano Zampini         PetscMPIInt rank;
4103779c1cceSStefano Zampini         PetscInt    spc,n_spc_p1,dest[1],destsize;
410474e2c79eSStefano Zampini 
410574e2c79eSStefano Zampini         ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
410658da7f69SStefano Zampini         spc = active_procs/ncoarse;
410758da7f69SStefano Zampini         n_spc_p1 = active_procs%ncoarse;
4108779c1cceSStefano Zampini         if (im_active) {
4109779c1cceSStefano Zampini           destsize = 1;
411074e2c79eSStefano Zampini           if (rank > n_spc_p1*(spc+1)-1) {
411174e2c79eSStefano Zampini             dest[0] = n_spc_p1+(rank-(n_spc_p1*(spc+1)))/spc;
411274e2c79eSStefano Zampini           } else {
411374e2c79eSStefano Zampini             dest[0] = rank/(spc+1);
411474e2c79eSStefano Zampini           }
411574e2c79eSStefano Zampini         } else {
4116779c1cceSStefano Zampini           destsize = 0;
41176e683305SStefano Zampini         }
4118779c1cceSStefano Zampini         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),destsize,dest,PETSC_COPY_VALUES,&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
4119779c1cceSStefano Zampini       } else if (csin_type_simple) {
41206e683305SStefano Zampini         PetscMPIInt rank;
41216e683305SStefano Zampini         PetscInt    issize,isidx;
4122779c1cceSStefano Zampini 
41236e683305SStefano Zampini         ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
41246e683305SStefano Zampini         if (im_active) {
41256e683305SStefano Zampini           issize = 1;
41266e683305SStefano Zampini           isidx = (PetscInt)rank;
41276e683305SStefano Zampini         } else {
41286e683305SStefano Zampini           issize = 0;
41296e683305SStefano Zampini           isidx = -1;
41306e683305SStefano Zampini         }
41316e683305SStefano Zampini         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),issize,&isidx,PETSC_COPY_VALUES,&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
4132779c1cceSStefano Zampini       } else { /* get a suitable subassembling pattern from MATIS code */
41336e683305SStefano Zampini         ierr = MatISGetSubassemblingPattern(t_coarse_mat_is,ncoarse,PETSC_TRUE,&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
41346e683305SStefano Zampini       }
4135779c1cceSStefano Zampini 
4136779c1cceSStefano Zampini       /* we need to shift on coarse candidates either if we are not redistributing or we are redistributing and we have enough void processes */
4137779c1cceSStefano Zampini       if (!redist || ncoarse <= void_procs) {
4138779c1cceSStefano Zampini         PetscInt ncoarse_cand,tissize,*nisindices;
4139779c1cceSStefano Zampini         PetscInt *coarse_candidates;
4140779c1cceSStefano Zampini         const PetscInt* tisindices;
4141779c1cceSStefano Zampini 
4142779c1cceSStefano Zampini         /* get coarse candidates' ranks in pc communicator */
4143779c1cceSStefano Zampini         ierr = PetscMalloc1(all_procs,&coarse_candidates);CHKERRQ(ierr);
4144779c1cceSStefano Zampini         ierr = MPI_Allgather(&im_active,1,MPIU_INT,coarse_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4145779c1cceSStefano Zampini         for (i=0,ncoarse_cand=0;i<all_procs;i++) {
4146779c1cceSStefano Zampini           if (!coarse_candidates[i]) {
4147779c1cceSStefano Zampini             coarse_candidates[ncoarse_cand++]=i;
4148779c1cceSStefano Zampini           }
4149779c1cceSStefano Zampini         }
4150779c1cceSStefano Zampini         if (ncoarse_cand < ncoarse) SETERRQ2(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen! %d < %d",ncoarse_cand,ncoarse);
4151779c1cceSStefano Zampini 
4152779c1cceSStefano Zampini 
41536e683305SStefano Zampini         if (pcbddc->dbg_flag) {
41546e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
41556e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Subassembling pattern init (before shift)\n");CHKERRQ(ierr);
41566e683305SStefano Zampini           ierr = ISView(pcbddc->coarse_subassembling_init,pcbddc->dbg_viewer);CHKERRQ(ierr);
41576e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse candidates\n");CHKERRQ(ierr);
4158779c1cceSStefano Zampini           for (i=0;i<ncoarse_cand;i++) {
41596e683305SStefano Zampini             ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"%d ",coarse_candidates[i]);CHKERRQ(ierr);
41606e683305SStefano Zampini           }
41616e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"\n");CHKERRQ(ierr);
41626e683305SStefano Zampini           ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
41636e683305SStefano Zampini         }
41646e683305SStefano Zampini         /* shift the pattern on coarse candidates */
41656e683305SStefano Zampini         ierr = ISGetLocalSize(pcbddc->coarse_subassembling_init,&tissize);CHKERRQ(ierr);
41666e683305SStefano Zampini         ierr = ISGetIndices(pcbddc->coarse_subassembling_init,&tisindices);CHKERRQ(ierr);
4167854ce69bSBarry Smith         ierr = PetscMalloc1(tissize,&nisindices);CHKERRQ(ierr);
41686e683305SStefano Zampini         for (i=0;i<tissize;i++) nisindices[i] = coarse_candidates[tisindices[i]];
41696e683305SStefano Zampini         ierr = ISRestoreIndices(pcbddc->coarse_subassembling_init,&tisindices);CHKERRQ(ierr);
41706e683305SStefano Zampini         ierr = ISGeneralSetIndices(pcbddc->coarse_subassembling_init,tissize,nisindices,PETSC_OWN_POINTER);CHKERRQ(ierr);
41716e683305SStefano Zampini         ierr = PetscFree(coarse_candidates);CHKERRQ(ierr);
41726e683305SStefano Zampini       }
41736e683305SStefano Zampini       if (pcbddc->dbg_flag) {
41746e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
41756e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Subassembling pattern init\n");CHKERRQ(ierr);
41766e683305SStefano Zampini         ierr = ISView(pcbddc->coarse_subassembling_init,pcbddc->dbg_viewer);CHKERRQ(ierr);
41776e683305SStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
41786e683305SStefano Zampini       }
4179779c1cceSStefano Zampini     }
41806e683305SStefano Zampini     /* get temporary coarse mat in IS format restricted on coarse procs (plus additional index sets of isarray) */
41816e683305SStefano Zampini     ierr = MatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling_init,0,PETSC_TRUE,MAT_INITIAL_MATRIX,&coarse_mat_is,nis,isarray);CHKERRQ(ierr);
41826e683305SStefano Zampini   } else {
41836e683305SStefano Zampini     if (pcbddc->dbg_flag) {
41846e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
41856e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Subassembling pattern init not needed\n");CHKERRQ(ierr);
41866e683305SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
41876e683305SStefano Zampini     }
41886e683305SStefano Zampini     ierr = PetscObjectReference((PetscObject)t_coarse_mat_is);CHKERRQ(ierr);
41896e683305SStefano Zampini     coarse_mat_is = t_coarse_mat_is;
41906e683305SStefano Zampini   }
41916e683305SStefano Zampini 
41926e683305SStefano Zampini   /* create local to global scatters for coarse problem */
419368457ee5SStefano Zampini   if (compute_vecs) {
41946e683305SStefano Zampini     PetscInt lrows;
41956e683305SStefano Zampini     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
41966e683305SStefano Zampini     if (coarse_mat_is) {
41976e683305SStefano Zampini       ierr = MatGetLocalSize(coarse_mat_is,&lrows,NULL);CHKERRQ(ierr);
41986e683305SStefano Zampini     } else {
41996e683305SStefano Zampini       lrows = 0;
42006e683305SStefano Zampini     }
42016e683305SStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
42026e683305SStefano Zampini     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
42036e683305SStefano Zampini     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
42046e683305SStefano Zampini     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
42056e683305SStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
42066e683305SStefano Zampini   }
42076e683305SStefano Zampini   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
42086e683305SStefano Zampini   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
4209c8587f34SStefano Zampini 
4210f9eb5b7dSStefano Zampini   /* set defaults for coarse KSP and PC */
4211f9eb5b7dSStefano Zampini   if (multilevel_allowed) {
4212f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPRICHARDSON;
4213f9eb5b7dSStefano Zampini     coarse_pc_type = PCBDDC;
4214f9eb5b7dSStefano Zampini   } else {
4215f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPPREONLY;
4216f9eb5b7dSStefano Zampini     coarse_pc_type = PCREDUNDANT;
4217c8587f34SStefano Zampini   }
4218c8587f34SStefano Zampini 
42196e683305SStefano Zampini   /* print some info if requested */
42206e683305SStefano Zampini   if (pcbddc->dbg_flag) {
42216e683305SStefano Zampini     if (!multilevel_allowed) {
42226e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
42236e683305SStefano Zampini       if (multilevel_requested) {
42246e683305SStefano 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);
42256e683305SStefano Zampini       } else if (pcbddc->max_levels) {
42266e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
42276e683305SStefano Zampini       }
42286e683305SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
42296e683305SStefano Zampini     }
42306e683305SStefano Zampini   }
42316e683305SStefano Zampini 
4232f9eb5b7dSStefano Zampini   /* create the coarse KSP object only once with defaults */
42336e683305SStefano Zampini   if (coarse_mat_is) {
42346e683305SStefano Zampini     MatReuse coarse_mat_reuse;
42356a1308c2SStefano Zampini     PetscViewer dbg_viewer = NULL;
42366e683305SStefano Zampini     if (pcbddc->dbg_flag) {
42376e683305SStefano Zampini       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat_is));
42386e683305SStefano Zampini       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
42396e683305SStefano Zampini     }
4240f9eb5b7dSStefano Zampini     if (!pcbddc->coarse_ksp) {
4241312be037SStefano Zampini       char prefix[256],str_level[16];
4242e604994aSStefano Zampini       size_t len;
42436e683305SStefano Zampini       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat_is),&pcbddc->coarse_ksp);CHKERRQ(ierr);
4244c8587f34SStefano Zampini       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
4245f9eb5b7dSStefano Zampini       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
42465f76c7aeSStefano Zampini       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat_is,coarse_mat_is);CHKERRQ(ierr);
4247c8587f34SStefano Zampini       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
42486e683305SStefano Zampini       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
4249c8587f34SStefano Zampini       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
4250c8587f34SStefano Zampini       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
42513e3c6dadSStefano Zampini       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4252e604994aSStefano Zampini       /* prefix */
4253e604994aSStefano Zampini       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
4254e604994aSStefano Zampini       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
4255e604994aSStefano Zampini       if (!pcbddc->current_level) {
4256e604994aSStefano Zampini         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4257e604994aSStefano Zampini         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
4258c8587f34SStefano Zampini       } else {
4259e604994aSStefano Zampini         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
4260312be037SStefano Zampini         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
4261312be037SStefano Zampini         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
426234d6797cSStefano Zampini         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4263312be037SStefano Zampini         sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
4264e604994aSStefano Zampini         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
4265e604994aSStefano Zampini       }
4266e604994aSStefano Zampini       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
42673e3c6dadSStefano Zampini       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
42683e3c6dadSStefano Zampini       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
42693e3c6dadSStefano Zampini       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
42703e3c6dadSStefano Zampini       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
4271f9eb5b7dSStefano Zampini       /* allow user customization */
4272f9eb5b7dSStefano Zampini       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
42733e3c6dadSStefano Zampini     }
42743e3c6dadSStefano Zampini     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
42753e3c6dadSStefano Zampini     if (nisdofs) {
42763e3c6dadSStefano Zampini       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
42773e3c6dadSStefano Zampini       for (i=0;i<nisdofs;i++) {
42783e3c6dadSStefano Zampini         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
42793e3c6dadSStefano Zampini       }
42803e3c6dadSStefano Zampini     }
42813e3c6dadSStefano Zampini     if (nisneu) {
42823e3c6dadSStefano Zampini       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
42833e3c6dadSStefano Zampini       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
4284312be037SStefano Zampini     }
4285f9eb5b7dSStefano Zampini 
4286f9eb5b7dSStefano Zampini     /* get some info after set from options */
4287f9eb5b7dSStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
4288f9eb5b7dSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
4289f9eb5b7dSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
42904f3a063dSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
42916e683305SStefano Zampini     if (isbddc && !multilevel_allowed) { /* multilevel can only be requested via pc_bddc_set_levels */
4292f9eb5b7dSStefano Zampini       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
4293f9eb5b7dSStefano Zampini       isbddc = PETSC_FALSE;
4294f9eb5b7dSStefano Zampini     }
42954f3a063dSStefano Zampini     if (isredundant) {
42964f3a063dSStefano Zampini       KSP inner_ksp;
42974f3a063dSStefano Zampini       PC inner_pc;
42984f3a063dSStefano Zampini       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
42994f3a063dSStefano Zampini       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
43004f3a063dSStefano Zampini       ierr = PCFactorSetReuseFill(inner_pc,PETSC_TRUE);CHKERRQ(ierr);
43014f3a063dSStefano Zampini     }
4302f9eb5b7dSStefano Zampini 
4303f9eb5b7dSStefano Zampini     /* assemble coarse matrix */
4304fa7f1dd8SStefano Zampini     if (coarse_reuse) {
430581d9aea3SBarry Smith       ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
4306fa7f1dd8SStefano Zampini       ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
43076e683305SStefano Zampini       coarse_mat_reuse = MAT_REUSE_MATRIX;
4308fa7f1dd8SStefano Zampini     } else {
43096e683305SStefano Zampini       coarse_mat_reuse = MAT_INITIAL_MATRIX;
4310fa7f1dd8SStefano Zampini     }
4311c8587f34SStefano Zampini     if (isbddc || isnn) {
431222bc73bbSStefano Zampini       if (pcbddc->coarsening_ratio > 1) {
431370cf5478SStefano Zampini         if (!pcbddc->coarse_subassembling) { /* subassembling info is not present */
431428143c3dSStefano Zampini           ierr = MatISGetSubassemblingPattern(coarse_mat_is,active_procs/pcbddc->coarsening_ratio,PETSC_TRUE,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
431522b6e8a2SStefano Zampini           if (pcbddc->dbg_flag) {
43166e683305SStefano Zampini             ierr = PetscViewerASCIIPrintf(dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
43176e683305SStefano Zampini             ierr = PetscViewerASCIIPrintf(dbg_viewer,"Subassembling pattern\n");CHKERRQ(ierr);
43186e683305SStefano Zampini             ierr = ISView(pcbddc->coarse_subassembling,dbg_viewer);CHKERRQ(ierr);
43196e683305SStefano Zampini             ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
432022b6e8a2SStefano Zampini           }
432170cf5478SStefano Zampini         }
43226e683305SStefano Zampini         ierr = MatISSubassemble(coarse_mat_is,pcbddc->coarse_subassembling,0,PETSC_FALSE,coarse_mat_reuse,&coarse_mat,0,NULL);CHKERRQ(ierr);
432370cf5478SStefano Zampini       } else {
432422bc73bbSStefano Zampini         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
432522bc73bbSStefano Zampini         coarse_mat = coarse_mat_is;
432622bc73bbSStefano Zampini       }
432722bc73bbSStefano Zampini     } else {
43282e1e5fa4SStefano Zampini       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
4329c8587f34SStefano Zampini     }
4330c8587f34SStefano Zampini     ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
4331c8587f34SStefano Zampini 
4332c8587f34SStefano Zampini     /* propagate symmetry info to coarse matrix */
4333b9d89cd5SStefano Zampini     ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pcbddc->issym);CHKERRQ(ierr);
43345a16e3a0SStefano Zampini     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
4335c8587f34SStefano Zampini 
43366e683305SStefano Zampini     /* set operators */
43375f76c7aeSStefano Zampini     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
43386e683305SStefano Zampini     if (pcbddc->dbg_flag) {
43396e683305SStefano Zampini       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
43406e683305SStefano Zampini     }
43416e683305SStefano Zampini   } else { /* processes non partecipating to coarse solver (if any) */
43426e683305SStefano Zampini     coarse_mat = 0;
43436e683305SStefano Zampini   }
43446e683305SStefano Zampini   ierr = PetscFree(isarray);CHKERRQ(ierr);
4345b9b85e73SStefano Zampini #if 0
4346b9b85e73SStefano Zampini   {
4347b9b85e73SStefano Zampini     PetscViewer viewer;
4348b9b85e73SStefano Zampini     char filename[256];
4349b9b85e73SStefano Zampini     sprintf(filename,"coarse_mat.m");
4350b9b85e73SStefano Zampini     ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,filename,&viewer);CHKERRQ(ierr);
4351b9b85e73SStefano Zampini     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4352b9b85e73SStefano Zampini     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
4353b9b85e73SStefano Zampini     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4354b9b85e73SStefano Zampini   }
4355b9b85e73SStefano Zampini #endif
4356c8587f34SStefano Zampini 
4357c8587f34SStefano Zampini   /* Compute coarse null space (special handling by BDDC only) */
4358c8587f34SStefano Zampini   if (pcbddc->NullSpace) {
4359c8587f34SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,coarse_mat,&CoarseNullSpace);CHKERRQ(ierr);
436098a51de6SStefano Zampini   }
436198a51de6SStefano Zampini 
436298a51de6SStefano Zampini   if (pcbddc->coarse_ksp) {
436398a51de6SStefano Zampini     Vec crhs,csol;
436498a51de6SStefano Zampini     PetscBool ispreonly;
436598a51de6SStefano Zampini     if (CoarseNullSpace) {
4366c8587f34SStefano Zampini       if (isbddc) {
4367c8587f34SStefano Zampini         ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
4368c8587f34SStefano Zampini       } else {
4369c8587f34SStefano Zampini         ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
4370c8587f34SStefano Zampini       }
4371c8587f34SStefano Zampini     }
4372f9eb5b7dSStefano Zampini     /* setup coarse ksp */
4373f9eb5b7dSStefano Zampini     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
4374f347579bSStefano Zampini     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
4375f347579bSStefano Zampini     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
43766e683305SStefano Zampini     /* hack */
4377f347579bSStefano Zampini     if (!csol) {
43782a7a6963SBarry Smith       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
4379f9eb5b7dSStefano Zampini     }
4380f347579bSStefano Zampini     if (!crhs) {
43812a7a6963SBarry Smith       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
4382f347579bSStefano Zampini     }
4383cbcc2c2aSStefano Zampini     /* Check coarse problem if in debug mode or if solving with an iterative method */
4384cbcc2c2aSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
43856e683305SStefano Zampini     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
4386c8587f34SStefano Zampini       KSP       check_ksp;
43872b510759SStefano Zampini       KSPType   check_ksp_type;
4388c8587f34SStefano Zampini       PC        check_pc;
43896e683305SStefano Zampini       Vec       check_vec,coarse_vec;
43906a1308c2SStefano Zampini       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
43912b510759SStefano Zampini       PetscInt  its;
43926e683305SStefano Zampini       PetscBool compute_eigs;
43936e683305SStefano Zampini       PetscReal *eigs_r,*eigs_c;
43946e683305SStefano Zampini       PetscInt  neigs;
43958e185a42SStefano Zampini       const char *prefix;
4396c8587f34SStefano Zampini 
43972b510759SStefano Zampini       /* Create ksp object suitable for estimation of extreme eigenvalues */
43986e683305SStefano Zampini       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
439923ee1639SBarry Smith       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
4400f4ddd8eeSStefano Zampini       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
44012b510759SStefano Zampini       if (ispreonly) {
44022b510759SStefano Zampini         check_ksp_type = KSPPREONLY;
44036e683305SStefano Zampini         compute_eigs = PETSC_FALSE;
44042b510759SStefano Zampini       } else {
4405cbcc2c2aSStefano Zampini         check_ksp_type = KSPGMRES;
44066e683305SStefano Zampini         compute_eigs = PETSC_TRUE;
4407c8587f34SStefano Zampini       }
4408c8587f34SStefano Zampini       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
44096e683305SStefano Zampini       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
44106e683305SStefano Zampini       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
44116e683305SStefano Zampini       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
4412a7dc3881SStefano Zampini       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
4413a7dc3881SStefano Zampini       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
4414a7dc3881SStefano Zampini       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
4415a7dc3881SStefano Zampini       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
4416c8587f34SStefano Zampini       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
4417c8587f34SStefano Zampini       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
4418c8587f34SStefano Zampini       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
4419c8587f34SStefano Zampini       /* create random vec */
44206e683305SStefano Zampini       ierr = KSPGetSolution(pcbddc->coarse_ksp,&coarse_vec);CHKERRQ(ierr);
44216e683305SStefano Zampini       ierr = VecDuplicate(coarse_vec,&check_vec);CHKERRQ(ierr);
4422c8587f34SStefano Zampini       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
4423c8587f34SStefano Zampini       if (CoarseNullSpace) {
4424c8587f34SStefano Zampini         ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
4425c8587f34SStefano Zampini       }
44266e683305SStefano Zampini       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
4427c8587f34SStefano Zampini       /* solve coarse problem */
44286e683305SStefano Zampini       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
4429c8587f34SStefano Zampini       if (CoarseNullSpace) {
44306e683305SStefano Zampini         ierr = MatNullSpaceRemove(CoarseNullSpace,coarse_vec);CHKERRQ(ierr);
4431c8587f34SStefano Zampini       }
4432cbcc2c2aSStefano Zampini       /* set eigenvalue estimation if preonly has not been requested */
44336e683305SStefano Zampini       if (compute_eigs) {
4434854ce69bSBarry Smith         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
4435854ce69bSBarry Smith         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
44366e683305SStefano Zampini         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
44376e683305SStefano Zampini         lambda_max = eigs_r[neigs-1];
44386e683305SStefano Zampini         lambda_min = eigs_r[0];
44396e683305SStefano Zampini         if (pcbddc->use_coarse_estimates) {
44406e683305SStefano Zampini           if (lambda_max>lambda_min) {
4441cbcc2c2aSStefano Zampini             ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max,lambda_min);CHKERRQ(ierr);
4442cbcc2c2aSStefano Zampini             ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
4443cbcc2c2aSStefano Zampini           }
4444c8587f34SStefano Zampini         }
4445c8587f34SStefano Zampini       }
4446cbcc2c2aSStefano Zampini 
4447c8587f34SStefano Zampini       /* check coarse problem residual error */
44486e683305SStefano Zampini       if (pcbddc->dbg_flag) {
44496e683305SStefano Zampini         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
44506e683305SStefano Zampini         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
44516e683305SStefano Zampini         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
4452c8587f34SStefano Zampini         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
44536e683305SStefano Zampini         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
44546e683305SStefano Zampini         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
4455c8587f34SStefano Zampini         ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
4456779c1cceSStefano Zampini         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
44576e683305SStefano Zampini         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
44586e683305SStefano Zampini         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
44596e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
44606e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
44616e683305SStefano Zampini         if (compute_eigs) {
44626e683305SStefano Zampini           PetscReal lambda_max_s,lambda_min_s;
4463deec49d1SStefano Zampini           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
4464c8587f34SStefano Zampini           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
44656e683305SStefano Zampini           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
44666e683305SStefano 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);
44676e683305SStefano Zampini           for (i=0;i<neigs;i++) {
44686e683305SStefano Zampini             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
4469c8587f34SStefano Zampini           }
44706e683305SStefano Zampini         }
44716e683305SStefano Zampini         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
44726e683305SStefano Zampini         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
44736e683305SStefano Zampini       }
4474c8587f34SStefano Zampini       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
44756e683305SStefano Zampini       if (compute_eigs) {
44766e683305SStefano Zampini         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
44776e683305SStefano Zampini         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
4478c8587f34SStefano Zampini       }
44796e683305SStefano Zampini     }
44806e683305SStefano Zampini   }
4481cbcc2c2aSStefano Zampini   /* print additional info */
4482cbcc2c2aSStefano Zampini   if (pcbddc->dbg_flag) {
44836e683305SStefano Zampini     /* waits until all processes reaches this point */
44846e683305SStefano Zampini     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
4485cbcc2c2aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
4486cbcc2c2aSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4487cbcc2c2aSStefano Zampini   }
4488cbcc2c2aSStefano Zampini 
44892b510759SStefano Zampini   /* free memory */
4490c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
4491fdc635d7SStefano Zampini   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
4492c8587f34SStefano Zampini   PetscFunctionReturn(0);
4493c8587f34SStefano Zampini }
4494674ae819SStefano Zampini 
4495f34684f1SStefano Zampini #undef __FUNCT__
4496f34684f1SStefano Zampini #define __FUNCT__ "PCBDDCComputePrimalNumbering"
4497f34684f1SStefano Zampini PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
4498f34684f1SStefano Zampini {
4499f34684f1SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4500f34684f1SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
4501f34684f1SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
450273be2a3aSStefano Zampini   PetscInt       i,coarse_size=0;
450373be2a3aSStefano Zampini   PetscInt       *local_primal_indices=NULL;
4504f34684f1SStefano Zampini   PetscErrorCode ierr;
4505f34684f1SStefano Zampini 
4506f34684f1SStefano Zampini   PetscFunctionBegin;
4507f34684f1SStefano Zampini   /* Compute global number of coarse dofs */
450889c96988SStefano Zampini   if (!pcbddc->primal_indices_local_idxs && pcbddc->local_primal_size) {
450989c96988SStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Local primal indices have not been created");
4510727cdba6SStefano Zampini   }
4511727cdba6SStefano 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);
4512f34684f1SStefano Zampini 
4513f34684f1SStefano Zampini   /* check numbering */
4514f34684f1SStefano Zampini   if (pcbddc->dbg_flag) {
4515f34684f1SStefano Zampini     PetscScalar coarsesum,*array;
4516b9b85e73SStefano Zampini     PetscBool set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
4517f34684f1SStefano Zampini 
4518f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4519f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4520f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
45210fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
4522f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
4523f34684f1SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
4524727cdba6SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
4525f34684f1SStefano Zampini     }
4526f34684f1SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
4527f34684f1SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
4528f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
4529f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4530f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4531f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4532f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4533f34684f1SStefano Zampini     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4534f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
4535f34684f1SStefano Zampini       if (array[i] == 1.0) {
4536b9b85e73SStefano Zampini         set_error = PETSC_TRUE;
4537f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d owned by a single process!\n",PetscGlobalRank,i);CHKERRQ(ierr);
4538f34684f1SStefano Zampini       }
4539f34684f1SStefano Zampini     }
4540b9b85e73SStefano Zampini     ierr = MPI_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4541f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4542f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
4543f34684f1SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
4544f34684f1SStefano Zampini     }
4545f34684f1SStefano Zampini     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4546f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
4547f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4548f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4549f34684f1SStefano Zampini     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
4550f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
4551b9b85e73SStefano Zampini     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
4552ca8b9ea9SStefano Zampini       PetscInt *gidxs;
4553ca8b9ea9SStefano Zampini 
4554ca8b9ea9SStefano Zampini       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
4555ca8b9ea9SStefano Zampini       ierr = ISLocalToGlobalMappingApply(matis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
4556f34684f1SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
4557f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4558f34684f1SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
4559f34684f1SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
45604bc2dc4bSStefano 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);
4561f34684f1SStefano Zampini       }
4562f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4563ca8b9ea9SStefano Zampini       ierr = PetscFree(gidxs);CHKERRQ(ierr);
4564f34684f1SStefano Zampini     }
4565f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4566302440fdSBarry Smith     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
4567f34684f1SStefano Zampini   }
45688bec7fa6SStefano Zampini   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
4569f34684f1SStefano Zampini   /* get back data */
4570f34684f1SStefano Zampini   *coarse_size_n = coarse_size;
4571f34684f1SStefano Zampini   *local_primal_indices_n = local_primal_indices;
4572674ae819SStefano Zampini   PetscFunctionReturn(0);
4573674ae819SStefano Zampini }
4574674ae819SStefano Zampini 
4575e456f2a8SStefano Zampini #undef __FUNCT__
4576e456f2a8SStefano Zampini #define __FUNCT__ "PCBDDCGlobalToLocal"
4577a7dc3881SStefano Zampini PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
4578e456f2a8SStefano Zampini {
4579e456f2a8SStefano Zampini   IS             localis_t;
4580a7dc3881SStefano Zampini   PetscInt       i,lsize,*idxs,n;
4581e456f2a8SStefano Zampini   PetscScalar    *vals;
4582e456f2a8SStefano Zampini   PetscErrorCode ierr;
4583e456f2a8SStefano Zampini 
4584e456f2a8SStefano Zampini   PetscFunctionBegin;
4585a7dc3881SStefano Zampini   /* get indices in local ordering exploiting local to global map */
4586e456f2a8SStefano Zampini   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
4587854ce69bSBarry Smith   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
4588e456f2a8SStefano Zampini   for (i=0;i<lsize;i++) vals[i] = 1.0;
4589e456f2a8SStefano Zampini   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
4590a7dc3881SStefano Zampini   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
4591a7dc3881SStefano Zampini   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
45921035eff8SStefano Zampini   if (idxs) { /* multilevel guard */
4593a7dc3881SStefano Zampini     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
45941035eff8SStefano Zampini   }
4595a7dc3881SStefano Zampini   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
4596e456f2a8SStefano Zampini   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
4597e456f2a8SStefano Zampini   ierr = PetscFree(vals);CHKERRQ(ierr);
4598a7dc3881SStefano Zampini   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
4599a7dc3881SStefano Zampini   /* now compute set in local ordering */
4600a7dc3881SStefano Zampini   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4601a7dc3881SStefano Zampini   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4602a7dc3881SStefano Zampini   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
4603a7dc3881SStefano Zampini   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
4604a7dc3881SStefano Zampini   for (i=0,lsize=0;i<n;i++) {
4605ff92baa0SMatthew G. Knepley     if (PetscRealPart(vals[i]) > 0.5) {
4606e456f2a8SStefano Zampini       lsize++;
4607e456f2a8SStefano Zampini     }
4608e456f2a8SStefano Zampini   }
4609854ce69bSBarry Smith   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
4610a7dc3881SStefano Zampini   for (i=0,lsize=0;i<n;i++) {
4611ff92baa0SMatthew G. Knepley     if (PetscRealPart(vals[i]) > 0.5) {
4612e456f2a8SStefano Zampini       idxs[lsize++] = i;
4613e456f2a8SStefano Zampini     }
4614e456f2a8SStefano Zampini   }
4615a7dc3881SStefano Zampini   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
4616a7dc3881SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
4617e456f2a8SStefano Zampini   *localis = localis_t;
4618e456f2a8SStefano Zampini   PetscFunctionReturn(0);
4619e456f2a8SStefano Zampini }
4620906d46d4SStefano Zampini 
4621906d46d4SStefano Zampini /* the next two functions will be called in KSPMatMult if a change of basis has been requested */
4622906d46d4SStefano Zampini #undef __FUNCT__
4623906d46d4SStefano Zampini #define __FUNCT__ "PCBDDCMatMult_Private"
4624906d46d4SStefano Zampini static PetscErrorCode PCBDDCMatMult_Private(Mat A, Vec x, Vec y)
4625906d46d4SStefano Zampini {
4626906d46d4SStefano Zampini   PCBDDCChange_ctx change_ctx;
4627906d46d4SStefano Zampini   PetscErrorCode   ierr;
4628906d46d4SStefano Zampini 
4629906d46d4SStefano Zampini   PetscFunctionBegin;
4630906d46d4SStefano Zampini   ierr = MatShellGetContext(A,&change_ctx);CHKERRQ(ierr);
4631906d46d4SStefano Zampini   ierr = MatMult(change_ctx->global_change,x,change_ctx->work[0]);CHKERRQ(ierr);
4632906d46d4SStefano Zampini   ierr = MatMult(change_ctx->original_mat,change_ctx->work[0],change_ctx->work[1]);CHKERRQ(ierr);
4633906d46d4SStefano Zampini   ierr = MatMultTranspose(change_ctx->global_change,change_ctx->work[1],y);CHKERRQ(ierr);
4634906d46d4SStefano Zampini   PetscFunctionReturn(0);
4635906d46d4SStefano Zampini }
4636906d46d4SStefano Zampini 
4637906d46d4SStefano Zampini #undef __FUNCT__
4638906d46d4SStefano Zampini #define __FUNCT__ "PCBDDCMatMultTranspose_Private"
4639906d46d4SStefano Zampini static PetscErrorCode PCBDDCMatMultTranspose_Private(Mat A, Vec x, Vec y)
4640906d46d4SStefano Zampini {
4641906d46d4SStefano Zampini   PCBDDCChange_ctx change_ctx;
4642906d46d4SStefano Zampini   PetscErrorCode   ierr;
4643906d46d4SStefano Zampini 
4644906d46d4SStefano Zampini   PetscFunctionBegin;
4645906d46d4SStefano Zampini   ierr = MatShellGetContext(A,&change_ctx);CHKERRQ(ierr);
4646906d46d4SStefano Zampini   ierr = MatMult(change_ctx->global_change,x,change_ctx->work[0]);CHKERRQ(ierr);
4647906d46d4SStefano Zampini   ierr = MatMultTranspose(change_ctx->original_mat,change_ctx->work[0],change_ctx->work[1]);CHKERRQ(ierr);
4648906d46d4SStefano Zampini   ierr = MatMultTranspose(change_ctx->global_change,change_ctx->work[1],y);CHKERRQ(ierr);
4649906d46d4SStefano Zampini   PetscFunctionReturn(0);
4650906d46d4SStefano Zampini }
4651b96c3477SStefano Zampini 
4652b96c3477SStefano Zampini #undef __FUNCT__
4653b96c3477SStefano Zampini #define __FUNCT__ "PCBDDCSetUpSubSchurs"
465408122e43SStefano Zampini PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
4655b96c3477SStefano Zampini {
4656b96c3477SStefano Zampini   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
4657b96c3477SStefano Zampini   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
4658b96c3477SStefano Zampini   PetscInt            *used_xadj,*used_adjncy;
4659b96c3477SStefano Zampini   PetscBool           free_used_adj;
4660b96c3477SStefano Zampini   PetscErrorCode      ierr;
4661b96c3477SStefano Zampini 
4662b96c3477SStefano Zampini   PetscFunctionBegin;
4663b96c3477SStefano Zampini   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
4664b96c3477SStefano Zampini   free_used_adj = PETSC_FALSE;
466508122e43SStefano Zampini   if (pcbddc->sub_schurs_layers == -1) {
4666b96c3477SStefano Zampini     used_xadj = NULL;
4667b96c3477SStefano Zampini     used_adjncy = NULL;
4668b96c3477SStefano Zampini   } else {
466908122e43SStefano Zampini     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
467008122e43SStefano Zampini       used_xadj = pcbddc->mat_graph->xadj;
467108122e43SStefano Zampini       used_adjncy = pcbddc->mat_graph->adjncy;
467208122e43SStefano Zampini     } else if (pcbddc->computed_rowadj) {
4673b96c3477SStefano Zampini       used_xadj = pcbddc->mat_graph->xadj;
4674b96c3477SStefano Zampini       used_adjncy = pcbddc->mat_graph->adjncy;
4675b96c3477SStefano Zampini     } else {
46762fffb893SStefano Zampini       PetscBool      flg_row=PETSC_FALSE;
4677b96c3477SStefano Zampini       const PetscInt *xadj,*adjncy;
4678b96c3477SStefano Zampini       PetscInt       nvtxs;
4679b96c3477SStefano Zampini 
46802fffb893SStefano Zampini       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
46812fffb893SStefano Zampini       if (flg_row) {
4682b96c3477SStefano Zampini         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
4683b96c3477SStefano Zampini         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
4684b96c3477SStefano Zampini         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
4685b96c3477SStefano Zampini         free_used_adj = PETSC_TRUE;
46862fffb893SStefano Zampini       } else {
46872fffb893SStefano Zampini         pcbddc->sub_schurs_layers = -1;
46882fffb893SStefano Zampini         used_xadj = NULL;
46892fffb893SStefano Zampini         used_adjncy = NULL;
46902fffb893SStefano Zampini       }
46912fffb893SStefano Zampini       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4692b96c3477SStefano Zampini     }
4693b96c3477SStefano Zampini   }
4694*d5574798SStefano Zampini 
4695*d5574798SStefano Zampini   /* set Schur complement solver for interior variables (used only when MUMPS is not present) */
4696*d5574798SStefano Zampini   if (!sub_schurs->use_mumps) {
4697*d5574798SStefano Zampini     ierr = MatSchurComplementSetKSP(sub_schurs->S,pcbddc->ksp_D);CHKERRQ(ierr);
4698*d5574798SStefano Zampini   }
4699*d5574798SStefano Zampini 
4700*d5574798SStefano Zampini   /* setup sub_schurs data */
4701ac632422SStefano 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);
4702b96c3477SStefano Zampini 
4703b96c3477SStefano Zampini   /* free adjacency */
4704b96c3477SStefano Zampini   if (free_used_adj) {
4705b96c3477SStefano Zampini     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
4706b96c3477SStefano Zampini   }
4707b96c3477SStefano Zampini   PetscFunctionReturn(0);
4708b96c3477SStefano Zampini }
4709b96c3477SStefano Zampini 
4710b96c3477SStefano Zampini #undef __FUNCT__
4711b96c3477SStefano Zampini #define __FUNCT__ "PCBDDCInitSubSchurs"
471208122e43SStefano Zampini PetscErrorCode PCBDDCInitSubSchurs(PC pc)
4713b96c3477SStefano Zampini {
4714b96c3477SStefano Zampini   PC_IS               *pcis=(PC_IS*)pc->data;
4715b96c3477SStefano Zampini   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
4716b96c3477SStefano Zampini   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
4717b96c3477SStefano Zampini   PCBDDCGraph         graph;
4718b96c3477SStefano Zampini   Mat                 S_j;
4719b96c3477SStefano Zampini   PetscErrorCode      ierr;
4720b96c3477SStefano Zampini 
4721b96c3477SStefano Zampini   PetscFunctionBegin;
4722b96c3477SStefano Zampini   /* attach interface graph for determining subsets */
472308122e43SStefano Zampini   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
4724b96c3477SStefano Zampini     IS verticesIS;
4725b96c3477SStefano Zampini 
4726b96c3477SStefano Zampini     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
4727b96c3477SStefano Zampini     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
4728b96c3477SStefano Zampini     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap);CHKERRQ(ierr);
4729b96c3477SStefano Zampini     ierr = PCBDDCGraphSetUp(graph,0,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticesIS);CHKERRQ(ierr);
4730b96c3477SStefano Zampini     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
4731b96c3477SStefano Zampini     ierr = ISDestroy(&verticesIS);CHKERRQ(ierr);
4732b96c3477SStefano Zampini /*
4733b96c3477SStefano Zampini     if (pcbddc->dbg_flag) {
4734b96c3477SStefano Zampini       ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
4735b96c3477SStefano Zampini     }
4736b96c3477SStefano Zampini */
4737b96c3477SStefano Zampini   } else {
4738b96c3477SStefano Zampini     graph = pcbddc->mat_graph;
4739b96c3477SStefano Zampini   }
4740b96c3477SStefano Zampini 
4741b96c3477SStefano Zampini   /* Create Schur complement matrix */
4742b96c3477SStefano Zampini   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
4743b96c3477SStefano Zampini 
4744b96c3477SStefano Zampini   /* sub_schurs init */
47455a95e1ceSStefano Zampini   ierr = PCBDDCSubSchursInit(sub_schurs,pcbddc->local_mat,S_j,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap);CHKERRQ(ierr);
4746b96c3477SStefano Zampini   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
4747b96c3477SStefano Zampini   /* free graph struct */
474808122e43SStefano Zampini   if (pcbddc->sub_schurs_rebuild) {
4749b96c3477SStefano Zampini     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
4750b96c3477SStefano Zampini   }
4751b96c3477SStefano Zampini   PetscFunctionReturn(0);
4752b96c3477SStefano Zampini }
4753