xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision e496cd5dfac3e9278b1c8f7c7cf0cc2eb88dc331)
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 
39*e496cd5dSStefano Zampini   if (pcbddc->dbg_flag) {
40*e496cd5dSStefano 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);
41*e496cd5dSStefano Zampini   }
42*e496cd5dSStefano Zampini 
43*e496cd5dSStefano Zampini   if (sub_schurs->n_subs && (!sub_schurs->is_hermitian || !sub_schurs->is_posdef)) {
44*e496cd5dSStefano 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);
45*e496cd5dSStefano Zampini   }
46*e496cd5dSStefano 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   if (pcbddc->adaptive_threshold > 1.0) {
6208122e43SStefano Zampini     thresh = 1.0/pcbddc->adaptive_threshold;
6308122e43SStefano Zampini   } else {
6408122e43SStefano Zampini     thresh = 1.0;
6508122e43SStefano Zampini   }
6608122e43SStefano Zampini 
6708122e43SStefano Zampini   /* allocate lapack workspace */
6808122e43SStefano Zampini   cum = cum2 = 0;
6908122e43SStefano Zampini   maxneigs = 0;
7008122e43SStefano Zampini   for (i=0;i<sub_schurs->n_subs;i++) {
7108122e43SStefano Zampini     if (PetscBTLookup(sub_schurs->computed_Stilda_subs,i)) {
7208122e43SStefano Zampini       PetscInt n,subset_size;
7308122e43SStefano Zampini       ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
7408122e43SStefano Zampini       n = PetscMin(subset_size,nmax);
7508122e43SStefano Zampini       cum += subset_size*n;
7608122e43SStefano Zampini       cum2 += n;
7708122e43SStefano Zampini       maxneigs = PetscMax(maxneigs,n);
7808122e43SStefano Zampini     }
7908122e43SStefano Zampini   }
8008122e43SStefano Zampini 
8108122e43SStefano Zampini   if (mss) {
829ab7bb16SStefano Zampini     if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
8308122e43SStefano Zampini       PetscBLASInt B_itype = 1;
8408122e43SStefano Zampini       PetscBLASInt B_N = mss;
854c6709b3SStefano Zampini       PetscReal    zero = 0.0;
864c6709b3SStefano Zampini       PetscReal    eps = 0.0; /* dlamch? */
8708122e43SStefano Zampini 
8808122e43SStefano Zampini       B_lwork = -1;
8908122e43SStefano Zampini       S = NULL;
9008122e43SStefano Zampini       St = NULL;
91a58a30b4SStefano Zampini       eigs = NULL;
92a58a30b4SStefano Zampini       eigv = NULL;
93a58a30b4SStefano Zampini       B_iwork = NULL;
94a58a30b4SStefano Zampini       B_ifail = NULL;
9508122e43SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
9608122e43SStefano Zampini #if defined(PETSC_USE_COMPLEX)
9708122e43SStefano Zampini       PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
9808122e43SStefano Zampini #else
9908122e43SStefano Zampini       PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,B_iwork,B_ifail,&B_ierr));
10008122e43SStefano Zampini #endif
10108122e43SStefano Zampini       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
10208122e43SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
10308122e43SStefano Zampini     } else {
10408122e43SStefano Zampini         /* TODO */
10508122e43SStefano Zampini     }
10608122e43SStefano Zampini   } else {
10708122e43SStefano Zampini     lwork = 0;
10808122e43SStefano Zampini   }
10908122e43SStefano Zampini 
11008122e43SStefano Zampini   nv = 0;
11108122e43SStefano Zampini   if (sub_schurs->is_Ej_com) { /* complement of subsets, each entry is a vertex */
11208122e43SStefano Zampini     ierr = ISGetLocalSize(sub_schurs->is_Ej_com,&nv);CHKERRQ(ierr);
11308122e43SStefano Zampini   }
1144c6709b3SStefano Zampini   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
11508122e43SStefano Zampini   ierr = PetscMalloc7(mss*mss,&S,mss*mss,&St,mss*mss,&eigv,mss,&eigs,
11608122e43SStefano Zampini                       B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
11708122e43SStefano Zampini #if defined(PETSC_USE_COMPLEX)
11808122e43SStefano Zampini   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
11908122e43SStefano Zampini #endif
12008122e43SStefano Zampini   ierr = PetscMalloc2(mss*mss,&Smult,mss*mss,&Seigv);CHKERRQ(ierr);
12108122e43SStefano Zampini   ierr = PetscMalloc4(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
12208122e43SStefano Zampini                       nv+cum2+1,&pcbddc->adaptive_constraints_ptrs,
12308122e43SStefano Zampini                       nv+cum,&pcbddc->adaptive_constraints_idxs,
12408122e43SStefano Zampini                       nv+cum,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
12508122e43SStefano Zampini   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
12608122e43SStefano Zampini 
12708122e43SStefano Zampini   maxneigs = 0;
12808122e43SStefano Zampini   cum = cum2 = cumarray = 0;
12908122e43SStefano Zampini   if (sub_schurs->is_Ej_com) {
13008122e43SStefano Zampini     const PetscInt *idxs;
13108122e43SStefano Zampini 
13208122e43SStefano Zampini     ierr = ISGetIndices(sub_schurs->is_Ej_com,&idxs);CHKERRQ(ierr);
13308122e43SStefano Zampini     for (cum=0;cum<nv;cum++) {
13408122e43SStefano Zampini       pcbddc->adaptive_constraints_n[cum] = 1;
13508122e43SStefano Zampini       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
13608122e43SStefano Zampini       pcbddc->adaptive_constraints_ptrs[cum] = cum;
13708122e43SStefano Zampini       pcbddc->adaptive_constraints_data[cum] = 1.0;
13808122e43SStefano Zampini     }
13908122e43SStefano Zampini     cum2 = cum;
14008122e43SStefano Zampini     ierr = ISRestoreIndices(sub_schurs->is_Ej_com,&idxs);CHKERRQ(ierr);
14108122e43SStefano Zampini   }
14208122e43SStefano Zampini 
14308122e43SStefano Zampini   if (mss) { /* multilevel */
14408122e43SStefano Zampini     if (pcbddc->use_deluxe_scaling) {
14508122e43SStefano Zampini       ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
14608122e43SStefano Zampini     } else {
14708122e43SStefano Zampini       ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_all,&Sarray);CHKERRQ(ierr);
14808122e43SStefano Zampini     }
14908122e43SStefano Zampini     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
15008122e43SStefano Zampini   }
15108122e43SStefano Zampini 
15208122e43SStefano Zampini   for (i=0;i<sub_schurs->n_subs;i++) {
15308122e43SStefano Zampini     PetscInt j,subset_size;
15408122e43SStefano Zampini 
15508122e43SStefano Zampini     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
15608122e43SStefano Zampini     if (PetscBTLookup(sub_schurs->computed_Stilda_subs,i)) {
15708122e43SStefano Zampini       const PetscInt *idxs;
1584c6709b3SStefano Zampini       PetscScalar    one = 1.0,scalar_zero = 0.0;
1594c6709b3SStefano Zampini       PetscReal      zero=0.0;
16008122e43SStefano Zampini       PetscBLASInt   B_N;
16108122e43SStefano Zampini 
16208122e43SStefano Zampini       /* S should be copied since we need it for deluxe scaling */
1639ab7bb16SStefano Zampini       if (sub_schurs->is_hermitian) {
16408122e43SStefano Zampini         PetscInt j;
16508122e43SStefano Zampini         for (j=0;j<subset_size;j++) {
16608122e43SStefano Zampini           ierr = PetscMemcpy(S+j*(subset_size+1),Sarray+cumarray+j*(subset_size+1),(subset_size-j)*sizeof(PetscScalar));CHKERRQ(ierr);
16708122e43SStefano Zampini         }
16808122e43SStefano Zampini         for (j=0;j<subset_size;j++) {
16908122e43SStefano Zampini           ierr = PetscMemcpy(St+j*(subset_size+1),Starray+cumarray+j*(subset_size+1),(subset_size-j)*sizeof(PetscScalar));CHKERRQ(ierr);
17008122e43SStefano Zampini         }
17108122e43SStefano Zampini       } else {
17208122e43SStefano Zampini         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
17308122e43SStefano Zampini         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
17408122e43SStefano Zampini       }
17508122e43SStefano Zampini       /* is always this the right matrix? */
17608122e43SStefano Zampini       ierr = PetscMemcpy(Smult,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
17708122e43SStefano Zampini 
17808122e43SStefano Zampini       /* we could reuse space already allocated when building sum_S_Ej_tilda_all */
17908122e43SStefano Zampini       /* St = Starray+cumarray; */
18008122e43SStefano Zampini 
1819ab7bb16SStefano Zampini       if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
18208122e43SStefano Zampini         PetscBLASInt B_itype = 1;
18308122e43SStefano Zampini         PetscBLASInt B_IL = 1, B_IU;
1844c6709b3SStefano Zampini         PetscReal    eps = -1.0; /* dlamch? */
1859552c7c7SStefano Zampini         PetscInt     nmin_s;
18608122e43SStefano Zampini 
18708122e43SStefano Zampini         /* ask for eigenvalues lower than thresh */
188fd14bc51SStefano Zampini         if (pcbddc->dbg_flag) {
189fd14bc51SStefano Zampini           PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %d/%d.\n",i,sub_schurs->n_subs);
190fd14bc51SStefano Zampini         }
19108122e43SStefano Zampini         ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
19208122e43SStefano Zampini         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
19308122e43SStefano Zampini #if defined(PETSC_USE_COMPLEX)
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,rwork,B_iwork,B_ifail,&B_ierr));
19508122e43SStefano Zampini #else
19608122e43SStefano 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));
19708122e43SStefano Zampini #endif
19808122e43SStefano Zampini         ierr = PetscFPTrapPop();CHKERRQ(ierr);
19908122e43SStefano Zampini         if (B_ierr) {
20008122e43SStefano Zampini           if (B_ierr < 0 ) {
20108122e43SStefano Zampini             SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
20208122e43SStefano Zampini           } else if (B_ierr <= B_N) {
20308122e43SStefano Zampini             SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr);
20408122e43SStefano Zampini           } else {
2059552c7c7SStefano Zampini             SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %d is not positive definite",(int)B_ierr-B_N-1);
20608122e43SStefano Zampini           }
20708122e43SStefano Zampini         }
20808122e43SStefano Zampini 
20908122e43SStefano Zampini         if (B_neigs > nmax) {
210fd14bc51SStefano Zampini           if (pcbddc->dbg_flag) {
211fd14bc51SStefano Zampini             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %d.\n",B_neigs,nmax);
212fd14bc51SStefano Zampini           }
21308122e43SStefano Zampini           B_neigs = nmax;
21408122e43SStefano Zampini         }
21508122e43SStefano Zampini 
2169552c7c7SStefano Zampini         nmin_s = PetscMin(nmin,B_N);
2179552c7c7SStefano Zampini         if (B_neigs < nmin_s) {
21808122e43SStefano Zampini           PetscBLASInt B_neigs2;
21908122e43SStefano Zampini 
22008122e43SStefano Zampini           B_IL = B_neigs + 1;
2219552c7c7SStefano Zampini           ierr = PetscBLASIntCast(nmin_s,&B_IU);CHKERRQ(ierr);
222fd14bc51SStefano Zampini           if (pcbddc->dbg_flag) {
223fd14bc51SStefano 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);
224fd14bc51SStefano Zampini           }
2259ab7bb16SStefano Zampini           if (sub_schurs->is_hermitian) {
22608122e43SStefano Zampini             PetscInt j;
22708122e43SStefano Zampini             for (j=0;j<subset_size;j++) {
22808122e43SStefano Zampini               ierr = PetscMemcpy(S+j*(subset_size+1),Sarray+cumarray+j*(subset_size+1),(subset_size-j)*sizeof(PetscScalar));CHKERRQ(ierr);
22908122e43SStefano Zampini             }
23008122e43SStefano Zampini             for (j=0;j<subset_size;j++) {
23108122e43SStefano Zampini               ierr = PetscMemcpy(St+j*(subset_size+1),Starray+cumarray+j*(subset_size+1),(subset_size-j)*sizeof(PetscScalar));CHKERRQ(ierr);
23208122e43SStefano Zampini             }
23308122e43SStefano Zampini           } else {
23408122e43SStefano Zampini             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
23508122e43SStefano Zampini             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
23608122e43SStefano Zampini           }
23708122e43SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
23808122e43SStefano Zampini #if defined(PETSC_USE_COMPLEX)
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,rwork,B_iwork,B_ifail,&B_ierr));
24008122e43SStefano Zampini #else
24108122e43SStefano 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));
24208122e43SStefano Zampini #endif
24308122e43SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
24408122e43SStefano Zampini           B_neigs += B_neigs2;
24508122e43SStefano Zampini         }
24608122e43SStefano Zampini         if (B_ierr) {
24708122e43SStefano Zampini           if (B_ierr < 0 ) {
24808122e43SStefano Zampini             SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
24908122e43SStefano Zampini           } else if (B_ierr <= B_N) {
25008122e43SStefano Zampini             SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr);
25108122e43SStefano Zampini           } else {
2529552c7c7SStefano 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);
25308122e43SStefano Zampini           }
25408122e43SStefano Zampini         }
255fd14bc51SStefano Zampini         if (pcbddc->dbg_flag) {
256fd14bc51SStefano Zampini           PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);
25708122e43SStefano Zampini           for (j=0;j<B_neigs;j++) {
25808122e43SStefano Zampini             if (eigs[j] == 0.0) {
259fd14bc51SStefano Zampini               PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");
26008122e43SStefano Zampini             } else {
261fd14bc51SStefano Zampini               PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1.0/eigs[j]);
262fd14bc51SStefano Zampini             }
26308122e43SStefano Zampini           }
26408122e43SStefano Zampini         }
26508122e43SStefano Zampini       } else {
26608122e43SStefano Zampini           /* TODO */
26708122e43SStefano Zampini       }
26808122e43SStefano Zampini       maxneigs = PetscMax(B_neigs,maxneigs);
2691b968477SStefano Zampini       pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
27008122e43SStefano Zampini 
27108122e43SStefano Zampini       ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
2724c6709b3SStefano Zampini       PetscStackCallBLAS("BLASgemm",BLASgemm_("N","N",&B_N,&B_neigs,&B_N,&one,Smult,&B_N,eigv,&B_N,&scalar_zero,Seigv,&B_N));
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       ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
28508122e43SStefano Zampini       for (j=0;j<B_neigs;j++) {
28608122e43SStefano Zampini #if 0
28708122e43SStefano Zampini         {
28808122e43SStefano Zampini           PetscBLASInt Blas_N,Blas_one = 1.0;
28908122e43SStefano Zampini           PetscScalar norm;
29008122e43SStefano Zampini           ierr = PetscBLASIntCast(subset_size,&Blas_N);CHKERRQ(ierr);
29108122e43SStefano Zampini           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,pcbddc->adaptive_constraints_data+cum2,&Blas_one,pcbddc->adaptive_constraints_data+cum2,&Blas_one));
29208122e43SStefano Zampini           if (pcbddc->adaptive_constraints_data[cum2] > 0.0) {
29308122e43SStefano Zampini             norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
29408122e43SStefano Zampini           } else {
29508122e43SStefano Zampini             norm = -1.0/PetscSqrtReal(PetscRealPart(norm));
29608122e43SStefano Zampini           }
29708122e43SStefano Zampini           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,pcbddc->adaptive_constraints_data+cum2,&Blas_one));
298b1b3d7a2SStefano Zampini         }
299b1b3d7a2SStefano Zampini #endif
30008122e43SStefano Zampini         ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+cum2,idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
30108122e43SStefano Zampini         pcbddc->adaptive_constraints_ptrs[cum++] = cum2;
30208122e43SStefano Zampini         cum2 += subset_size;
30308122e43SStefano Zampini       }
30408122e43SStefano Zampini       ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
30508122e43SStefano Zampini     }
30608122e43SStefano Zampini     /* shift for next computation */
30708122e43SStefano Zampini     cumarray += subset_size*subset_size;
30808122e43SStefano Zampini   }
309fd14bc51SStefano Zampini   if (pcbddc->dbg_flag) {
310fd14bc51SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
311fd14bc51SStefano Zampini   }
31208122e43SStefano Zampini   pcbddc->adaptive_constraints_ptrs[cum] = cum2;
31308122e43SStefano Zampini   ierr = PetscFree2(Smult,Seigv);CHKERRQ(ierr);
31408122e43SStefano Zampini 
31508122e43SStefano Zampini   if (mss) {
31608122e43SStefano Zampini     if (pcbddc->use_deluxe_scaling) {
31708122e43SStefano Zampini       ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
31808122e43SStefano Zampini     } else {
31908122e43SStefano Zampini       ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_all,&Sarray);CHKERRQ(ierr);
32008122e43SStefano Zampini     }
32108122e43SStefano Zampini     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
32208122e43SStefano Zampini   }
32308122e43SStefano Zampini   ierr = PetscFree7(S,St,eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
32408122e43SStefano Zampini #if defined(PETSC_USE_COMPLEX)
32508122e43SStefano Zampini   ierr = PetscFree(rwork);CHKERRQ(ierr);
32608122e43SStefano Zampini #endif
32708122e43SStefano Zampini   if (pcbddc->dbg_flag) {
3281b968477SStefano Zampini     PetscInt maxneigs_r;
32908122e43SStefano Zampini     ierr = MPI_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
33008122e43SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Maximum number of constraints per cc %d\n",maxneigs_r);CHKERRQ(ierr);
33108122e43SStefano Zampini   }
33208122e43SStefano Zampini   PetscFunctionReturn(0);
33308122e43SStefano Zampini }
334b1b3d7a2SStefano Zampini 
335674ae819SStefano Zampini #undef __FUNCT__
336c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpSolvers"
337c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpSolvers(PC pc)
338c8587f34SStefano Zampini {
339c8587f34SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3408629588bSStefano Zampini   PetscScalar    *coarse_submat_vals;
341c8587f34SStefano Zampini   PetscErrorCode ierr;
342c8587f34SStefano Zampini 
343c8587f34SStefano Zampini   PetscFunctionBegin;
344f4ddd8eeSStefano Zampini   /* Setup local scatters R_to_B and (optionally) R_to_D */
3455e8657edSStefano Zampini   /* PCBDDCSetUpLocalWorkVectors should be called first! */
346c8587f34SStefano Zampini   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
347c8587f34SStefano Zampini 
348684f6988SStefano Zampini   /* Setup local neumann solver ksp_R */
3490fccc4e9SStefano Zampini   /* PCBDDCSetUpLocalScatters should be called first! */
350684f6988SStefano Zampini   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
351c8587f34SStefano Zampini 
352c8587f34SStefano Zampini   /* Change global null space passed in by the user if change of basis has been requested */
353b9b85e73SStefano Zampini   if (pcbddc->NullSpace && pcbddc->ChangeOfBasisMatrix) {
354c8587f34SStefano Zampini     ierr = PCBDDCNullSpaceAdaptGlobal(pc);CHKERRQ(ierr);
355c8587f34SStefano Zampini   }
356c8587f34SStefano Zampini 
3578629588bSStefano Zampini   /*
3588629588bSStefano Zampini      Setup local correction and local part of coarse basis.
3598629588bSStefano Zampini      Gives back the dense local part of the coarse matrix in column major ordering
3608629588bSStefano Zampini   */
36147f4ddc3SStefano Zampini   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3628629588bSStefano Zampini 
3638629588bSStefano Zampini   /* Compute total number of coarse nodes and setup coarse solver */
3648629588bSStefano Zampini   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3658629588bSStefano Zampini 
3668629588bSStefano Zampini   /* free */
3678629588bSStefano Zampini   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
368c8587f34SStefano Zampini   PetscFunctionReturn(0);
369c8587f34SStefano Zampini }
370c8587f34SStefano Zampini 
371c8587f34SStefano Zampini #undef __FUNCT__
372674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetCustomization"
373674ae819SStefano Zampini PetscErrorCode PCBDDCResetCustomization(PC pc)
374674ae819SStefano Zampini {
375674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
376674ae819SStefano Zampini   PetscErrorCode ierr;
377674ae819SStefano Zampini 
378674ae819SStefano Zampini   PetscFunctionBegin;
379674ae819SStefano Zampini   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
380674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
381674ae819SStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->NullSpace);CHKERRQ(ierr);
382674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
383785d1243SStefano Zampini   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
384674ae819SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
385f4ddd8eeSStefano Zampini   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
386f4ddd8eeSStefano Zampini   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
387785d1243SStefano Zampini   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
38863602bcaSStefano Zampini   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
38963602bcaSStefano Zampini   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
390674ae819SStefano Zampini   PetscFunctionReturn(0);
391674ae819SStefano Zampini }
392674ae819SStefano Zampini 
393674ae819SStefano Zampini #undef __FUNCT__
394674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetTopography"
395674ae819SStefano Zampini PetscErrorCode PCBDDCResetTopography(PC pc)
396674ae819SStefano Zampini {
397674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
398674ae819SStefano Zampini   PetscErrorCode ierr;
399674ae819SStefano Zampini 
400674ae819SStefano Zampini   PetscFunctionBegin;
401b9b85e73SStefano Zampini   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
402674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
403674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
404674ae819SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
405b96c3477SStefano Zampini   ierr = PCBDDCSubSchursReset(pcbddc->sub_schurs);CHKERRQ(ierr);
406674ae819SStefano Zampini   PetscFunctionReturn(0);
407674ae819SStefano Zampini }
408674ae819SStefano Zampini 
409674ae819SStefano Zampini #undef __FUNCT__
410674ae819SStefano Zampini #define __FUNCT__ "PCBDDCResetSolvers"
411674ae819SStefano Zampini PetscErrorCode PCBDDCResetSolvers(PC pc)
412674ae819SStefano Zampini {
413674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
41406656605SStefano Zampini   PetscScalar    *array;
415674ae819SStefano Zampini   PetscErrorCode ierr;
416674ae819SStefano Zampini 
417674ae819SStefano Zampini   PetscFunctionBegin;
418674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
41958da7f69SStefano Zampini   if (pcbddc->coarse_phi_B) {
42006656605SStefano Zampini     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
42106656605SStefano Zampini     ierr = PetscFree(array);CHKERRQ(ierr);
42258da7f69SStefano Zampini   }
423674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
424674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
42515aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
42615aaf578SStefano Zampini   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
427674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
428674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
42906656605SStefano Zampini   if (pcbddc->local_auxmat2) {
43006656605SStefano Zampini     ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
43106656605SStefano Zampini     ierr = PetscFree(array);CHKERRQ(ierr);
43206656605SStefano Zampini   }
433674ae819SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
43406656605SStefano Zampini   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
435674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
436674ae819SStefano Zampini   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
4378ce42a96SStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
438674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
439674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
440674ae819SStefano Zampini   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
441f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->ksp_D);CHKERRQ(ierr);
442f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->ksp_R);CHKERRQ(ierr);
443f4ddd8eeSStefano Zampini   ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
444f4ddd8eeSStefano Zampini   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
445727cdba6SStefano Zampini   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
446f4ddd8eeSStefano Zampini   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
44770cf5478SStefano Zampini   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
4486e683305SStefano Zampini   ierr = ISDestroy(&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
449674ae819SStefano Zampini   PetscFunctionReturn(0);
450674ae819SStefano Zampini }
451674ae819SStefano Zampini 
452674ae819SStefano Zampini #undef __FUNCT__
453f4ddd8eeSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalWorkVectors"
454f4ddd8eeSStefano Zampini PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
4556bfb1811SStefano Zampini {
4566bfb1811SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
4576bfb1811SStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
4586bfb1811SStefano Zampini   VecType        impVecType;
459e9189074SStefano Zampini   PetscInt       n_constraints,n_R,old_size;
4606bfb1811SStefano Zampini   PetscErrorCode ierr;
4616bfb1811SStefano Zampini 
4626bfb1811SStefano Zampini   PetscFunctionBegin;
463f4ddd8eeSStefano Zampini   if (!pcbddc->ConstraintMatrix) {
464f4ddd8eeSStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Constraint matrix has not been created");
465f4ddd8eeSStefano Zampini   }
466e7b262bdSStefano Zampini   /* get sizes */
467e9189074SStefano Zampini   n_constraints = pcbddc->local_primal_size - pcbddc->n_actual_vertices;
468e9189074SStefano Zampini   n_R = pcis->n-pcbddc->n_actual_vertices;
4696bfb1811SStefano Zampini   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
470e7b262bdSStefano Zampini   /* local work vectors (try to avoid unneeded work)*/
471e7b262bdSStefano Zampini   /* R nodes */
472e7b262bdSStefano Zampini   old_size = -1;
473e7b262bdSStefano Zampini   if (pcbddc->vec1_R) {
474e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
475e7b262bdSStefano Zampini   }
476e7b262bdSStefano Zampini   if (n_R != old_size) {
477e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
478e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
4796bfb1811SStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
4806bfb1811SStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
4816bfb1811SStefano Zampini     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
4826bfb1811SStefano Zampini     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
483e7b262bdSStefano Zampini   }
484e7b262bdSStefano Zampini   /* local primal dofs */
485e7b262bdSStefano Zampini   old_size = -1;
486e7b262bdSStefano Zampini   if (pcbddc->vec1_P) {
487e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
488e7b262bdSStefano Zampini   }
489e9189074SStefano Zampini   if (pcbddc->local_primal_size != old_size) {
490e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
49183b7ccabSStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
492e9189074SStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
4936bfb1811SStefano Zampini     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
494e7b262bdSStefano Zampini   }
495e7b262bdSStefano Zampini   /* local explicit constraints */
496e7b262bdSStefano Zampini   old_size = -1;
497e7b262bdSStefano Zampini   if (pcbddc->vec1_C) {
498e7b262bdSStefano Zampini     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
499e7b262bdSStefano Zampini   }
500e7b262bdSStefano Zampini   if (n_constraints && n_constraints != old_size) {
501e7b262bdSStefano Zampini     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
50283b7ccabSStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
50383b7ccabSStefano Zampini     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
50483b7ccabSStefano Zampini     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
50583b7ccabSStefano Zampini   }
5066bfb1811SStefano Zampini   PetscFunctionReturn(0);
5076bfb1811SStefano Zampini }
5086bfb1811SStefano Zampini 
5096bfb1811SStefano Zampini #undef __FUNCT__
51047f4ddc3SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCorrection"
51147f4ddc3SStefano Zampini PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
51288ebb749SStefano Zampini {
51325084f0cSStefano Zampini   PetscErrorCode         ierr;
51425084f0cSStefano Zampini   /* pointers to pcis and pcbddc */
51588ebb749SStefano Zampini   PC_IS*                 pcis = (PC_IS*)pc->data;
51688ebb749SStefano Zampini   PC_BDDC*               pcbddc = (PC_BDDC*)pc->data;
51725084f0cSStefano Zampini   /* submatrices of local problem */
51888ebb749SStefano Zampini   Mat                    A_RV,A_VR,A_VV;
51906656605SStefano Zampini   /* submatrices of local coarse problem */
52006656605SStefano Zampini   Mat                    S_VV,S_CV,S_VC,S_CC;
52125084f0cSStefano Zampini   /* working matrices */
52206656605SStefano Zampini   Mat                    C_CR;
52325084f0cSStefano Zampini   /* additional working stuff */
52406656605SStefano Zampini   PC                     pc_R;
52506656605SStefano Zampini   Mat                    F;
52606656605SStefano Zampini   PetscBool              isLU,isCHOL,isILU;
52706656605SStefano Zampini 
52825084f0cSStefano Zampini   PetscScalar            *coarse_submat_vals; /* TODO: use a PETSc matrix */
52906656605SStefano Zampini   PetscScalar            *work;
53006656605SStefano Zampini   PetscInt               *idx_V_B;
53106656605SStefano Zampini   PetscInt               n,n_vertices,n_constraints;
53206656605SStefano Zampini   PetscInt               i,n_R,n_D,n_B;
533b9d89cd5SStefano Zampini   PetscBool              unsymmetric_check;
53445a1bb75SStefano Zampini   /* matrix type (vector type propagated downstream from vec1_C and local matrix type) */
53588ebb749SStefano Zampini   MatType                impMatType;
53625084f0cSStefano Zampini   /* some shortcuts to scalars */
53706656605SStefano Zampini   PetscScalar            one=1.0,m_one=-1.0;
53888ebb749SStefano Zampini 
53988ebb749SStefano Zampini   PetscFunctionBegin;
540e9189074SStefano Zampini   /* get number of vertices (corners plus constraints with change of basis)
541e9189074SStefano Zampini      pcbddc->n_actual_vertices stores the actual number of vertices, pcbddc->n_vertices the number of corners computed */
542e9189074SStefano Zampini   n_vertices = pcbddc->n_actual_vertices;
54388ebb749SStefano Zampini   n_constraints = pcbddc->local_primal_size-n_vertices;
54488ebb749SStefano Zampini   /* Set Non-overlapping dimensions */
54588ebb749SStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
54688ebb749SStefano Zampini   n_R = pcis->n-n_vertices;
54788ebb749SStefano Zampini 
54888ebb749SStefano Zampini   /* Set types for local objects needed by BDDC precondtioner */
54988ebb749SStefano Zampini   impMatType = MATSEQDENSE;
55088ebb749SStefano Zampini 
55188ebb749SStefano Zampini   /* vertices in boundary numbering */
552785e854fSJed Brown   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
5535e8657edSStefano Zampini   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->primal_indices_local_idxs,&i,idx_V_B);CHKERRQ(ierr);
55488ebb749SStefano Zampini   if (i != n_vertices) {
55522d5777bSStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %d != %d\n",n_vertices,i);
55688ebb749SStefano Zampini   }
55788ebb749SStefano Zampini 
55806656605SStefano Zampini   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
55906656605SStefano Zampini   ierr = PetscMalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
56006656605SStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
56106656605SStefano Zampini   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
56206656605SStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
56306656605SStefano Zampini   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
56406656605SStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
56506656605SStefano Zampini   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
56606656605SStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
56706656605SStefano Zampini   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
56806656605SStefano Zampini 
56906656605SStefano Zampini   unsymmetric_check = PETSC_FALSE;
57006656605SStefano Zampini   /* allocate workspace */
57106656605SStefano Zampini   n = 0;
57206656605SStefano Zampini   if (n_constraints) {
57306656605SStefano Zampini     n += n_R*n_constraints;
57406656605SStefano Zampini   }
57506656605SStefano Zampini   if (n_vertices) {
57606656605SStefano Zampini     n = PetscMax(2*n_R*n_vertices,n);
57706656605SStefano Zampini   }
57806656605SStefano Zampini   if (!pcbddc->issym) {
57906656605SStefano Zampini     n = PetscMax(2*n_R*pcbddc->local_primal_size,n);
58006656605SStefano Zampini     unsymmetric_check = PETSC_TRUE;
58106656605SStefano Zampini   }
58206656605SStefano Zampini   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
58306656605SStefano Zampini 
58406656605SStefano Zampini   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
58506656605SStefano Zampini   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
58606656605SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
58706656605SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
58806656605SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
58906656605SStefano Zampini   if (isLU || isILU || isCHOL) {
59006656605SStefano Zampini     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
59106656605SStefano Zampini   } else {
59206656605SStefano Zampini     F = NULL;
59306656605SStefano Zampini   }
59406656605SStefano Zampini 
59588ebb749SStefano Zampini   /* Precompute stuffs needed for preprocessing and application of BDDC*/
59688ebb749SStefano Zampini   if (n_constraints) {
59706656605SStefano Zampini     Mat M1,M2,M3;
59806656605SStefano Zampini     IS  is_aux;
599f4ddd8eeSStefano Zampini     /* see if we can save some allocations */
600f4ddd8eeSStefano Zampini     if (pcbddc->local_auxmat2) {
601f4ddd8eeSStefano Zampini       PetscInt on_R,on_constraints;
602f4ddd8eeSStefano Zampini       ierr = MatGetSize(pcbddc->local_auxmat2,&on_R,&on_constraints);CHKERRQ(ierr);
603f4ddd8eeSStefano Zampini       if (on_R != n_R || on_constraints != n_constraints) {
60406656605SStefano Zampini         PetscScalar *marray;
60506656605SStefano Zampini 
60606656605SStefano Zampini         ierr = MatDenseGetArray(pcbddc->local_auxmat2,&marray);CHKERRQ(ierr);
60706656605SStefano Zampini         ierr = PetscFree(marray);CHKERRQ(ierr);
608f4ddd8eeSStefano Zampini         ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
609f4ddd8eeSStefano Zampini         ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
610f4ddd8eeSStefano Zampini       }
611f4ddd8eeSStefano Zampini     }
61245a1bb75SStefano Zampini     /* auxiliary matrices */
613f4ddd8eeSStefano Zampini     if (!pcbddc->local_auxmat2) {
61406656605SStefano Zampini       PetscScalar *marray;
61506656605SStefano Zampini 
61606656605SStefano Zampini       ierr = PetscMalloc1(2*n_R*n_constraints,&marray);CHKERRQ(ierr);
61706656605SStefano Zampini       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,marray,&pcbddc->local_auxmat2);CHKERRQ(ierr);
61806656605SStefano Zampini       marray += n_R*n_constraints;
61906656605SStefano Zampini       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_R,marray,&pcbddc->local_auxmat1);CHKERRQ(ierr);
620f4ddd8eeSStefano Zampini     }
62188ebb749SStefano Zampini 
62225084f0cSStefano Zampini     /* Extract constraints on R nodes: C_{CR}  */
62325084f0cSStefano Zampini     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
6248ce42a96SStefano Zampini     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
62525084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
62688ebb749SStefano Zampini 
62788ebb749SStefano Zampini     /* Assemble local_auxmat2 = - A_{RR}^{-1} C^T_{CR} needed by BDDC application */
62806656605SStefano Zampini     ierr = PetscMemzero(work,n_R*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
62988ebb749SStefano Zampini     for (i=0;i<n_constraints;i++) {
63006656605SStefano Zampini       const PetscScalar *row_cmat_values;
63106656605SStefano Zampini       const PetscInt    *row_cmat_indices;
63206656605SStefano Zampini       PetscInt          size_of_constraint,j;
63388ebb749SStefano Zampini 
63406656605SStefano Zampini       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
63506656605SStefano Zampini       for (j=0;j<size_of_constraint;j++) {
63606656605SStefano Zampini         work[row_cmat_indices[j]+i*n_R] = -row_cmat_values[j];
63706656605SStefano Zampini       }
63806656605SStefano Zampini       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
63906656605SStefano Zampini     }
64006656605SStefano Zampini     if (F) {
64106656605SStefano Zampini       Mat B;
64206656605SStefano Zampini 
64306656605SStefano Zampini       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
64406656605SStefano Zampini       ierr = MatMatSolve(F,B,pcbddc->local_auxmat2);CHKERRQ(ierr);
64506656605SStefano Zampini       ierr = MatDestroy(&B);CHKERRQ(ierr);
64606656605SStefano Zampini     } else {
64706656605SStefano Zampini       PetscScalar *xarray;
64806656605SStefano Zampini       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&xarray);CHKERRQ(ierr);
64906656605SStefano Zampini       for (i=0;i<n_constraints;i++) {
65006656605SStefano Zampini         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
65106656605SStefano Zampini         ierr = VecPlaceArray(pcbddc->vec2_R,xarray+i*n_R);CHKERRQ(ierr);
65206656605SStefano Zampini         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
65306656605SStefano Zampini         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
65406656605SStefano Zampini         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
65506656605SStefano Zampini       }
65606656605SStefano Zampini       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&xarray);CHKERRQ(ierr);
65706656605SStefano Zampini     }
65806656605SStefano Zampini 
65906656605SStefano Zampini     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
66006656605SStefano Zampini     ierr = MatConvert(C_CR,impMatType,MAT_REUSE_MATRIX,&C_CR);CHKERRQ(ierr);
66125084f0cSStefano Zampini     ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
66206656605SStefano Zampini     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M1);CHKERRQ(ierr);
66306656605SStefano Zampini     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
66425084f0cSStefano Zampini     ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
66506656605SStefano Zampini     ierr = VecSet(pcbddc->vec1_C,m_one);CHKERRQ(ierr);
66606656605SStefano Zampini     ierr = MatDiagonalSet(M2,pcbddc->vec1_C,INSERT_VALUES);CHKERRQ(ierr);
66725084f0cSStefano Zampini     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
66825084f0cSStefano Zampini     ierr = MatDestroy(&M2);CHKERRQ(ierr);
66925084f0cSStefano Zampini     ierr = MatDestroy(&M3);CHKERRQ(ierr);
67006656605SStefano Zampini     /* Assemble local_auxmat1 = S_CC*C_{CR} needed by BDDC application in KSP and in preproc */
671f4ddd8eeSStefano Zampini     ierr = MatMatMult(M1,C_CR,MAT_REUSE_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
67206656605SStefano Zampini     ierr = MatCopy(M1,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
67306656605SStefano Zampini     ierr = MatDestroy(&M1);CHKERRQ(ierr);
67488ebb749SStefano Zampini   }
67588ebb749SStefano Zampini   /* Get submatrices from subdomain matrix */
67688ebb749SStefano Zampini   if (n_vertices) {
67706656605SStefano Zampini     Mat       newmat;
67806656605SStefano Zampini     IS        is_aux;
6793a50541eSStefano Zampini     PetscInt  ibs,mbs;
6803a50541eSStefano Zampini     PetscBool issbaij;
6813a50541eSStefano Zampini 
6823a50541eSStefano Zampini     ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
6839577ea80SStefano Zampini     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
6849577ea80SStefano Zampini     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
6853a50541eSStefano Zampini     if (ibs != mbs) { /* need to convert to SEQAIJ */
6869577ea80SStefano Zampini       ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
6879577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
6889577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
6899577ea80SStefano Zampini       ierr = MatGetSubMatrix(newmat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
6909577ea80SStefano Zampini       ierr = MatDestroy(&newmat);CHKERRQ(ierr);
6919577ea80SStefano Zampini     } else {
6923a50541eSStefano Zampini       /* this is safe */
6939577ea80SStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
6943a50541eSStefano Zampini       ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
6953a50541eSStefano Zampini       if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
6963a50541eSStefano Zampini         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
6973a50541eSStefano Zampini         ierr = MatGetSubMatrix(newmat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
69806656605SStefano Zampini         ierr = MatTranspose(A_VR,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
6993a50541eSStefano Zampini         ierr = MatDestroy(&newmat);CHKERRQ(ierr);
70003af80d8SStefano Zampini         ierr = MatConvert(A_VV,MATSEQBAIJ,MAT_REUSE_MATRIX,&A_VV);CHKERRQ(ierr);
7013a50541eSStefano Zampini       } else {
7029577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
7039577ea80SStefano Zampini         ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
7049577ea80SStefano Zampini       }
7053a50541eSStefano Zampini     }
70625084f0cSStefano Zampini     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
70788ebb749SStefano Zampini   }
70888ebb749SStefano Zampini 
70988ebb749SStefano Zampini   /* Matrix of coarse basis functions (local) */
710f4ddd8eeSStefano Zampini   if (pcbddc->coarse_phi_B) {
71106656605SStefano Zampini     PetscInt on_B,on_primal,on_D=n_D;
71206656605SStefano Zampini     if (pcbddc->coarse_phi_D) {
71306656605SStefano Zampini       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
71406656605SStefano Zampini     }
715f4ddd8eeSStefano Zampini     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
71606656605SStefano Zampini     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
71706656605SStefano Zampini       PetscScalar *marray;
71806656605SStefano Zampini 
71906656605SStefano Zampini       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
72006656605SStefano Zampini       ierr = PetscFree(marray);CHKERRQ(ierr);
721f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
722f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
723f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
724f4ddd8eeSStefano Zampini       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
725f4ddd8eeSStefano Zampini     }
726f4ddd8eeSStefano Zampini   }
72706656605SStefano Zampini 
728f4ddd8eeSStefano Zampini   if (!pcbddc->coarse_phi_B) {
72906656605SStefano Zampini     PetscScalar *marray;
73088ebb749SStefano Zampini 
73106656605SStefano Zampini     n = n_B*pcbddc->local_primal_size;
7328eeda7d8SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
73306656605SStefano Zampini       n += n_D*pcbddc->local_primal_size;
73488ebb749SStefano Zampini     }
735b9d89cd5SStefano Zampini     if (!pcbddc->issym) {
73606656605SStefano Zampini       n *= 2;
737f4ddd8eeSStefano Zampini     }
73806656605SStefano Zampini     ierr = PetscCalloc1(n,&marray);CHKERRQ(ierr);
73906656605SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marray,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
74006656605SStefano Zampini     n = n_B*pcbddc->local_primal_size;
74106656605SStefano Zampini     if (pcbddc->switch_static || pcbddc->dbg_flag) {
74206656605SStefano Zampini       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
74306656605SStefano Zampini       n += n_D*pcbddc->local_primal_size;
74488ebb749SStefano Zampini     }
74506656605SStefano Zampini     if (!pcbddc->issym) {
74606656605SStefano Zampini       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
7471b968477SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
74806656605SStefano Zampini         n = n_B*pcbddc->local_primal_size;
74906656605SStefano Zampini         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
75088ebb749SStefano Zampini       }
75188ebb749SStefano Zampini     } else {
752c0553b1fSStefano Zampini       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
753c0553b1fSStefano Zampini       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
7541b968477SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
755c0553b1fSStefano Zampini         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
756c0553b1fSStefano Zampini         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
757c0553b1fSStefano Zampini       }
75888ebb749SStefano Zampini     }
75906656605SStefano Zampini   }
76006656605SStefano Zampini   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
76106656605SStefano Zampini   /* vertices */
76206656605SStefano Zampini   if (n_vertices) {
76316f15bc4SStefano Zampini 
76416f15bc4SStefano Zampini     if (n_R) {
76506656605SStefano Zampini       Mat          A_RRmA_RV,S_VVt; /* S_VVt with LDA=N */
76606656605SStefano Zampini       PetscBLASInt B_N,B_one = 1;
76716f15bc4SStefano Zampini       PetscScalar  *x,*y;
76806656605SStefano Zampini 
76906656605SStefano Zampini       ierr = PetscMemzero(work,2*n_R*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
77006656605SStefano Zampini       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
77106656605SStefano Zampini       ierr = MatConvert(A_RV,impMatType,MAT_REUSE_MATRIX,&A_RV);CHKERRQ(ierr);
77206656605SStefano Zampini       if (F) {
77306656605SStefano Zampini         ierr = MatMatSolve(F,A_RV,A_RRmA_RV);CHKERRQ(ierr);
77406656605SStefano Zampini       } else {
77506656605SStefano Zampini         ierr = MatDenseGetArray(A_RV,&y);CHKERRQ(ierr);
77606656605SStefano Zampini         for (i=0;i<n_vertices;i++) {
77706656605SStefano Zampini           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*n_R);CHKERRQ(ierr);
77806656605SStefano Zampini           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
77906656605SStefano Zampini           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
78006656605SStefano Zampini           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
78106656605SStefano Zampini           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
78206656605SStefano Zampini         }
78306656605SStefano Zampini         ierr = MatDenseRestoreArray(A_RV,&y);CHKERRQ(ierr);
78406656605SStefano Zampini       }
78506656605SStefano Zampini       ierr = MatScale(A_RRmA_RV,m_one);CHKERRQ(ierr);
78606656605SStefano Zampini       /* S_VV and S_CV are the subdomain contribution to coarse matrix. WARNING -> column major ordering */
78706656605SStefano Zampini       if (n_constraints) {
78806656605SStefano Zampini         Mat B;
78906656605SStefano Zampini         ierr = MatMatMult(pcbddc->local_auxmat1,A_RRmA_RV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
79006656605SStefano Zampini         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work+n_R*n_vertices,&B);CHKERRQ(ierr);
79106656605SStefano Zampini         ierr = MatMatMult(pcbddc->local_auxmat2,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
79206656605SStefano Zampini         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
79306656605SStefano Zampini         ierr = PetscBLASIntCast(n_R*n_vertices,&B_N);CHKERRQ(ierr);
79406656605SStefano Zampini         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+n_R*n_vertices,&B_one,work,&B_one));
79506656605SStefano Zampini         ierr = MatDestroy(&B);CHKERRQ(ierr);
79606656605SStefano Zampini       }
79706656605SStefano Zampini       ierr = MatConvert(A_VR,impMatType,MAT_REUSE_MATRIX,&A_VR);CHKERRQ(ierr);
79806656605SStefano Zampini       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
79906656605SStefano Zampini       ierr = MatConvert(A_VV,impMatType,MAT_REUSE_MATRIX,&A_VV);CHKERRQ(ierr);
80006656605SStefano Zampini       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
80106656605SStefano Zampini       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
80206656605SStefano Zampini       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
80306656605SStefano Zampini       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
80406656605SStefano Zampini       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
80506656605SStefano Zampini       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
80606656605SStefano Zampini       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
80706656605SStefano Zampini       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
80816f15bc4SStefano Zampini       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
80916f15bc4SStefano Zampini     } else {
81016f15bc4SStefano Zampini       ierr = MatConvert(A_VV,impMatType,MAT_REUSE_MATRIX,&A_VV);CHKERRQ(ierr);
81116f15bc4SStefano Zampini       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
81216f15bc4SStefano Zampini     }
81306656605SStefano Zampini     /* coarse basis functions */
81406656605SStefano Zampini     for (i=0;i<n_vertices;i++) {
81516f15bc4SStefano Zampini       PetscScalar *y;
81616f15bc4SStefano Zampini 
81706656605SStefano Zampini       ierr = VecPlaceArray(pcbddc->vec1_R,work+n_R*i);CHKERRQ(ierr);
81806656605SStefano Zampini       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
81906656605SStefano Zampini       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
82006656605SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
82106656605SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
82206656605SStefano Zampini       y[n_B*i+idx_V_B[i]] = 1.0;
82306656605SStefano Zampini       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
82406656605SStefano Zampini       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
82506656605SStefano Zampini 
82606656605SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
82706656605SStefano Zampini         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
82806656605SStefano Zampini         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
82906656605SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
83006656605SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
83106656605SStefano Zampini         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
83206656605SStefano Zampini         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
83306656605SStefano Zampini       }
83406656605SStefano Zampini       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
83506656605SStefano Zampini     }
83616f15bc4SStefano Zampini     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
83706656605SStefano Zampini     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
83806656605SStefano Zampini   }
83906656605SStefano Zampini 
84006656605SStefano Zampini   if (n_constraints) {
84106656605SStefano Zampini     Mat B;
84206656605SStefano Zampini 
84306656605SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
84406656605SStefano Zampini     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
84506656605SStefano Zampini     ierr = MatMatMult(pcbddc->local_auxmat2,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
84606656605SStefano Zampini     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
84706656605SStefano Zampini     if (n_vertices) {
84806656605SStefano Zampini       ierr = MatMatMult(A_VR,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_VC);CHKERRQ(ierr);
84906656605SStefano Zampini     }
85006656605SStefano Zampini     ierr = MatDestroy(&B);CHKERRQ(ierr);
85106656605SStefano Zampini     /* coarse basis functions */
85206656605SStefano Zampini     for (i=0;i<n_constraints;i++) {
85306656605SStefano Zampini       PetscScalar *y;
85406656605SStefano Zampini 
85506656605SStefano Zampini       ierr = VecPlaceArray(pcbddc->vec1_R,work+n_R*i);CHKERRQ(ierr);
85606656605SStefano Zampini       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
85706656605SStefano Zampini       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
85806656605SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
85906656605SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
86006656605SStefano Zampini       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
86106656605SStefano Zampini       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
86206656605SStefano Zampini 
86306656605SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
86406656605SStefano Zampini         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
86506656605SStefano Zampini         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
86606656605SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
86706656605SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
86806656605SStefano Zampini         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
86906656605SStefano Zampini         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
87006656605SStefano Zampini       }
87106656605SStefano Zampini       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
87206656605SStefano Zampini     }
87306656605SStefano Zampini   }
87406656605SStefano Zampini 
87506656605SStefano Zampini   /* compute other basis functions for non-symmetric problems */
87606656605SStefano Zampini   if (!pcbddc->issym) {
87706656605SStefano Zampini     Mat B,X;
87806656605SStefano Zampini 
87906656605SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,pcbddc->local_primal_size,work,&B);CHKERRQ(ierr);
88006656605SStefano Zampini 
88106656605SStefano Zampini     if (n_constraints) {
88216f15bc4SStefano Zampini       Mat S_CCT,B_C;
88306656605SStefano Zampini 
88406656605SStefano Zampini       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work+n_vertices*n_R,&B_C);CHKERRQ(ierr);
88506656605SStefano Zampini       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
88606656605SStefano Zampini       ierr = MatTransposeMatMult(C_CR,S_CCT,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
88716f15bc4SStefano Zampini       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
88806656605SStefano Zampini       if (n_vertices) {
88916f15bc4SStefano Zampini         Mat B_V,S_VCT;
89006656605SStefano Zampini 
89106656605SStefano Zampini         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&B_V);CHKERRQ(ierr);
89206656605SStefano Zampini         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
89306656605SStefano Zampini         ierr = MatTransposeMatMult(C_CR,S_VCT,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
89406656605SStefano Zampini         ierr = MatDestroy(&B_V);CHKERRQ(ierr);
89516f15bc4SStefano Zampini         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
89606656605SStefano Zampini       }
89706656605SStefano Zampini       ierr = MatDestroy(&B_C);CHKERRQ(ierr);
89806656605SStefano Zampini     }
89916f15bc4SStefano Zampini     if (n_vertices && n_R) {
90006656605SStefano Zampini       Mat          A_VRT;
90106656605SStefano Zampini       PetscBLASInt B_N,B_one = 1;
90206656605SStefano Zampini 
90306656605SStefano Zampini       if (!n_constraints) { /* if there are no constraints, reset work */
90406656605SStefano Zampini         ierr = PetscMemzero(work,n_R*pcbddc->local_primal_size*sizeof(PetscScalar));CHKERRQ(ierr);
90506656605SStefano Zampini       }
90606656605SStefano Zampini       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work+pcbddc->local_primal_size*n_R,&A_VRT);CHKERRQ(ierr);
90706656605SStefano Zampini       ierr = MatTranspose(A_VR,MAT_REUSE_MATRIX,&A_VRT);CHKERRQ(ierr);
90806656605SStefano Zampini       ierr = PetscBLASIntCast(n_vertices*n_R,&B_N);CHKERRQ(ierr);
90906656605SStefano Zampini       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&m_one,work+pcbddc->local_primal_size*n_R,&B_one,work,&B_one));
91016f15bc4SStefano Zampini       ierr = MatDestroy(&A_VRT);CHKERRQ(ierr);
91106656605SStefano Zampini     }
91206656605SStefano Zampini 
91306656605SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,pcbddc->local_primal_size,work+pcbddc->local_primal_size*n_R,&X);CHKERRQ(ierr);
91406656605SStefano Zampini     if (F) { /* currently there's no support for MatTransposeMatSolve(F,B,X) */
91506656605SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
91606656605SStefano Zampini         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
91706656605SStefano Zampini         ierr = VecPlaceArray(pcbddc->vec2_R,work+(i+pcbddc->local_primal_size)*n_R);CHKERRQ(ierr);
91806656605SStefano Zampini         ierr = MatSolveTranspose(F,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
91906656605SStefano Zampini         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
92006656605SStefano Zampini         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
92106656605SStefano Zampini       }
92206656605SStefano Zampini     } else {
92306656605SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
92406656605SStefano Zampini         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
92506656605SStefano Zampini         ierr = VecPlaceArray(pcbddc->vec2_R,work+(i+pcbddc->local_primal_size)*n_R);CHKERRQ(ierr);
92606656605SStefano Zampini         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
92706656605SStefano Zampini         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
92806656605SStefano Zampini         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
92906656605SStefano Zampini       }
93006656605SStefano Zampini     }
93106656605SStefano Zampini     ierr = MatDestroy(&B);CHKERRQ(ierr);
93206656605SStefano Zampini     /* coarse basis functions */
93306656605SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
93406656605SStefano Zampini       PetscScalar *y;
93506656605SStefano Zampini 
93606656605SStefano Zampini       ierr = VecPlaceArray(pcbddc->vec1_R,work+n_R*(i+pcbddc->local_primal_size));CHKERRQ(ierr);
93706656605SStefano Zampini       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
93806656605SStefano Zampini       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
93906656605SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
94006656605SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
94106656605SStefano Zampini       if (i<n_vertices) {
94206656605SStefano Zampini         y[n_B*i+idx_V_B[i]] = 1.0;
94306656605SStefano Zampini       }
94406656605SStefano Zampini       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
94506656605SStefano Zampini       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
94606656605SStefano Zampini 
94706656605SStefano Zampini       if (pcbddc->switch_static || pcbddc->dbg_flag) {
94806656605SStefano Zampini         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
94906656605SStefano Zampini         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
95006656605SStefano Zampini         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
95106656605SStefano Zampini         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
95206656605SStefano Zampini         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
95306656605SStefano Zampini         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
95406656605SStefano Zampini       }
95506656605SStefano Zampini       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
95606656605SStefano Zampini     }
95706656605SStefano Zampini     ierr = MatDestroy(&X);CHKERRQ(ierr);
95806656605SStefano Zampini   }
95906656605SStefano Zampini 
96088ebb749SStefano Zampini   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
96106656605SStefano Zampini   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
96206656605SStefano Zampini   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
96306656605SStefano Zampini   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
96406656605SStefano Zampini   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
96588ebb749SStefano Zampini   /* Checking coarse_sub_mat and coarse basis functios */
96688ebb749SStefano Zampini   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
96788ebb749SStefano Zampini   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
96825084f0cSStefano Zampini   if (pcbddc->dbg_flag) {
96988ebb749SStefano Zampini     Mat         coarse_sub_mat;
97025084f0cSStefano Zampini     Mat         AUXMAT,TM1,TM2,TM3,TM4;
97188ebb749SStefano Zampini     Mat         coarse_phi_D,coarse_phi_B;
97288ebb749SStefano Zampini     Mat         coarse_psi_D,coarse_psi_B;
97388ebb749SStefano Zampini     Mat         A_II,A_BB,A_IB,A_BI;
97488ebb749SStefano Zampini     MatType     checkmattype=MATSEQAIJ;
97588ebb749SStefano Zampini     PetscReal   real_value;
97688ebb749SStefano Zampini 
97788ebb749SStefano Zampini     ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
97888ebb749SStefano Zampini     ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
97988ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
98088ebb749SStefano Zampini     ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
98188ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
98288ebb749SStefano Zampini     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
983c0553b1fSStefano Zampini     if (unsymmetric_check) {
98488ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
98588ebb749SStefano Zampini       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
98688ebb749SStefano Zampini     }
98788ebb749SStefano Zampini     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
98888ebb749SStefano Zampini 
98925084f0cSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
99006656605SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation\n");CHKERRQ(ierr);
99125084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
992c0553b1fSStefano Zampini     if (unsymmetric_check) {
99388ebb749SStefano Zampini       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
99488ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
99588ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
99688ebb749SStefano Zampini       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
99788ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
99888ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
99988ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
100088ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
100188ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
100288ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
100388ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
100488ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
100588ebb749SStefano Zampini     } else {
100688ebb749SStefano Zampini       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
100788ebb749SStefano Zampini       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
100888ebb749SStefano Zampini       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
100988ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
101088ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
101188ebb749SStefano Zampini       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
101288ebb749SStefano Zampini       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
101388ebb749SStefano Zampini       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
101488ebb749SStefano Zampini     }
101588ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
101688ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
101788ebb749SStefano Zampini     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
101888ebb749SStefano Zampini     ierr = MatConvert(TM1,MATSEQDENSE,MAT_REUSE_MATRIX,&TM1);CHKERRQ(ierr);
101981d9aea3SBarry Smith     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
102088ebb749SStefano Zampini     ierr = MatNorm(TM1,NORM_INFINITY,&real_value);CHKERRQ(ierr);
102106656605SStefano Zampini 
10220fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
102306656605SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
102425084f0cSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
102588ebb749SStefano Zampini     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
102688ebb749SStefano Zampini     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
102788ebb749SStefano Zampini     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
102888ebb749SStefano Zampini     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
102988ebb749SStefano Zampini     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
103088ebb749SStefano Zampini     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
103188ebb749SStefano Zampini     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
103288ebb749SStefano Zampini     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
103388ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
103488ebb749SStefano Zampini     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
1035c0553b1fSStefano Zampini     if (unsymmetric_check) {
103688ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
103788ebb749SStefano Zampini       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
103888ebb749SStefano Zampini     }
103988ebb749SStefano Zampini     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
104088ebb749SStefano Zampini   }
104106656605SStefano Zampini 
104288ebb749SStefano Zampini   /* free memory */
104306656605SStefano Zampini   ierr = PetscFree(work);CHKERRQ(ierr);
104488ebb749SStefano Zampini   if (n_vertices) {
104588ebb749SStefano Zampini     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
104688ebb749SStefano Zampini   }
104788ebb749SStefano Zampini   if (n_constraints) {
104888ebb749SStefano Zampini     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
104988ebb749SStefano Zampini   }
10508629588bSStefano Zampini   /* get back data */
10518629588bSStefano Zampini   *coarse_submat_vals_n = coarse_submat_vals;
105288ebb749SStefano Zampini   PetscFunctionReturn(0);
105388ebb749SStefano Zampini }
105488ebb749SStefano Zampini 
105588ebb749SStefano Zampini #undef __FUNCT__
1056d65f70fdSStefano Zampini #define __FUNCT__ "MatGetSubMatrixUnsorted"
1057d648f858SStefano Zampini PetscErrorCode MatGetSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
1058d65f70fdSStefano Zampini {
1059d65f70fdSStefano Zampini   Mat            *work_mat;
1060d65f70fdSStefano Zampini   IS             isrow_s,iscol_s;
1061d65f70fdSStefano Zampini   PetscBool      rsorted,csorted;
1062d65f70fdSStefano Zampini   PetscInt       rsize,*idxs_perm_r,csize,*idxs_perm_c;
1063d65f70fdSStefano Zampini   PetscErrorCode ierr;
1064d65f70fdSStefano Zampini 
1065d65f70fdSStefano Zampini   PetscFunctionBegin;
1066d65f70fdSStefano Zampini   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
1067d65f70fdSStefano Zampini   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
1068d65f70fdSStefano Zampini   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
1069d65f70fdSStefano Zampini   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
1070d65f70fdSStefano Zampini 
1071d65f70fdSStefano Zampini   if (!rsorted) {
1072d65f70fdSStefano Zampini     const PetscInt *idxs;
1073d65f70fdSStefano Zampini     PetscInt *idxs_sorted,i;
1074d65f70fdSStefano Zampini 
1075d65f70fdSStefano Zampini     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
1076d65f70fdSStefano Zampini     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
1077d65f70fdSStefano Zampini     for (i=0;i<rsize;i++) {
1078d65f70fdSStefano Zampini       idxs_perm_r[i] = i;
1079d65f70fdSStefano Zampini     }
1080d65f70fdSStefano Zampini     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
1081d65f70fdSStefano Zampini     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
1082d65f70fdSStefano Zampini     for (i=0;i<rsize;i++) {
1083d65f70fdSStefano Zampini       idxs_sorted[i] = idxs[idxs_perm_r[i]];
1084d65f70fdSStefano Zampini     }
1085d65f70fdSStefano Zampini     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
1086d65f70fdSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
1087d65f70fdSStefano Zampini   } else {
1088d65f70fdSStefano Zampini     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
1089d65f70fdSStefano Zampini     isrow_s = isrow;
1090d65f70fdSStefano Zampini   }
1091d65f70fdSStefano Zampini 
1092d65f70fdSStefano Zampini   if (!csorted) {
1093d65f70fdSStefano Zampini     if (isrow == iscol) {
1094d65f70fdSStefano Zampini       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
1095d65f70fdSStefano Zampini       iscol_s = isrow_s;
1096d65f70fdSStefano Zampini     } else {
1097d65f70fdSStefano Zampini       const PetscInt *idxs;
1098d65f70fdSStefano Zampini       PetscInt *idxs_sorted,i;
1099d65f70fdSStefano Zampini 
1100d65f70fdSStefano Zampini       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
1101d65f70fdSStefano Zampini       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
1102d65f70fdSStefano Zampini       for (i=0;i<csize;i++) {
1103d65f70fdSStefano Zampini         idxs_perm_c[i] = i;
1104d65f70fdSStefano Zampini       }
1105d65f70fdSStefano Zampini       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
1106d65f70fdSStefano Zampini       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
1107d65f70fdSStefano Zampini       for (i=0;i<csize;i++) {
1108d65f70fdSStefano Zampini         idxs_sorted[i] = idxs[idxs_perm_c[i]];
1109d65f70fdSStefano Zampini       }
1110d65f70fdSStefano Zampini       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
1111d65f70fdSStefano Zampini       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
1112d65f70fdSStefano Zampini     }
1113d65f70fdSStefano Zampini   } else {
1114d65f70fdSStefano Zampini     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
1115d65f70fdSStefano Zampini     iscol_s = iscol;
1116d65f70fdSStefano Zampini   }
1117d65f70fdSStefano Zampini 
1118d648f858SStefano Zampini   ierr = MatGetSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
1119d65f70fdSStefano Zampini 
1120d65f70fdSStefano Zampini   if (!rsorted || !csorted) {
1121d65f70fdSStefano Zampini     Mat      new_mat;
1122d65f70fdSStefano Zampini     IS       is_perm_r,is_perm_c;
1123d65f70fdSStefano Zampini 
1124d65f70fdSStefano Zampini     if (!rsorted) {
1125d65f70fdSStefano Zampini       PetscInt *idxs_r,i;
1126d65f70fdSStefano Zampini       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
1127d65f70fdSStefano Zampini       for (i=0;i<rsize;i++) {
1128d65f70fdSStefano Zampini         idxs_r[idxs_perm_r[i]] = i;
1129d65f70fdSStefano Zampini       }
1130d65f70fdSStefano Zampini       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
1131d65f70fdSStefano Zampini       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
1132d65f70fdSStefano Zampini     } else {
1133d65f70fdSStefano Zampini       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
1134d65f70fdSStefano Zampini     }
1135d65f70fdSStefano Zampini     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
1136d65f70fdSStefano Zampini 
1137d65f70fdSStefano Zampini     if (!csorted) {
1138d65f70fdSStefano Zampini       if (isrow_s == iscol_s) {
1139d65f70fdSStefano Zampini         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
1140d65f70fdSStefano Zampini         is_perm_c = is_perm_r;
1141d65f70fdSStefano Zampini       } else {
1142d65f70fdSStefano Zampini         PetscInt *idxs_c,i;
1143d65f70fdSStefano Zampini         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
1144d65f70fdSStefano Zampini         for (i=0;i<csize;i++) {
1145d65f70fdSStefano Zampini           idxs_c[idxs_perm_c[i]] = i;
1146d65f70fdSStefano Zampini         }
1147d65f70fdSStefano Zampini         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
1148d65f70fdSStefano Zampini         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
1149d65f70fdSStefano Zampini       }
1150d65f70fdSStefano Zampini     } else {
1151d65f70fdSStefano Zampini       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
1152d65f70fdSStefano Zampini     }
1153d65f70fdSStefano Zampini     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
1154d65f70fdSStefano Zampini 
1155d65f70fdSStefano Zampini     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
1156d65f70fdSStefano Zampini     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
1157d65f70fdSStefano Zampini     work_mat[0] = new_mat;
1158d65f70fdSStefano Zampini     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
1159d65f70fdSStefano Zampini     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
1160d65f70fdSStefano Zampini   }
1161d65f70fdSStefano Zampini 
1162d65f70fdSStefano Zampini   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
1163d65f70fdSStefano Zampini   *B = work_mat[0];
1164d65f70fdSStefano Zampini   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
1165d65f70fdSStefano Zampini   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
1166d65f70fdSStefano Zampini   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
1167d65f70fdSStefano Zampini   PetscFunctionReturn(0);
1168d65f70fdSStefano Zampini }
1169d65f70fdSStefano Zampini 
1170d65f70fdSStefano Zampini #undef __FUNCT__
11715e8657edSStefano Zampini #define __FUNCT__ "PCBDDCComputeLocalMatrix"
11725e8657edSStefano Zampini PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
1173aa0d41d4SStefano Zampini {
1174aa0d41d4SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
11755e8657edSStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
1176d65f70fdSStefano Zampini   Mat            new_mat;
11775e8657edSStefano Zampini   IS             is_local,is_global;
1178d65f70fdSStefano Zampini   PetscInt       local_size;
1179d65f70fdSStefano Zampini   PetscBool      isseqaij;
1180aa0d41d4SStefano Zampini   PetscErrorCode ierr;
1181aa0d41d4SStefano Zampini 
1182aa0d41d4SStefano Zampini   PetscFunctionBegin;
1183aa0d41d4SStefano Zampini   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
11845e8657edSStefano Zampini   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
11855e8657edSStefano Zampini   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
1186906d46d4SStefano Zampini   ierr = ISLocalToGlobalMappingApplyIS(matis->mapping,is_local,&is_global);CHKERRQ(ierr);
1187906d46d4SStefano Zampini   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
1188d648f858SStefano Zampini   ierr = MatGetSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
1189906d46d4SStefano Zampini   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
1190906d46d4SStefano Zampini 
1191906d46d4SStefano Zampini   /* check */
1192906d46d4SStefano Zampini   if (pcbddc->dbg_flag) {
1193906d46d4SStefano Zampini     Vec       x,x_change;
1194906d46d4SStefano Zampini     PetscReal error;
1195906d46d4SStefano Zampini 
11965e8657edSStefano Zampini     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
1197906d46d4SStefano Zampini     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
11985e8657edSStefano Zampini     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
11995e8657edSStefano Zampini     ierr = VecScatterBegin(matis->ctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
12005e8657edSStefano Zampini     ierr = VecScatterEnd(matis->ctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1201d65f70fdSStefano Zampini     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
12025e8657edSStefano Zampini     ierr = VecScatterBegin(matis->ctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
12035e8657edSStefano Zampini     ierr = VecScatterEnd(matis->ctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1204906d46d4SStefano Zampini     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
1205906d46d4SStefano Zampini     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
1206906d46d4SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1207906d46d4SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Error global vs local change on N: %1.6e\n",error);CHKERRQ(ierr);
1208906d46d4SStefano Zampini     ierr = VecDestroy(&x);CHKERRQ(ierr);
1209906d46d4SStefano Zampini     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
1210906d46d4SStefano Zampini   }
1211906d46d4SStefano Zampini 
121222d5777bSStefano Zampini   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
12139b28b3ffSStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
121422d5777bSStefano Zampini   if (isseqaij) {
1215d65f70fdSStefano Zampini     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
1216aa0d41d4SStefano Zampini   } else {
1217aa0d41d4SStefano Zampini     Mat work_mat;
1218aa0d41d4SStefano Zampini     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
1219d65f70fdSStefano Zampini     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
1220aa0d41d4SStefano Zampini     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
1221aa0d41d4SStefano Zampini   }
1222d65f70fdSStefano Zampini   ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,pcbddc->issym);CHKERRQ(ierr);
1223*e496cd5dSStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1224*e496cd5dSStefano Zampini   ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,pcbddc->issym);CHKERRQ(ierr);
1225*e496cd5dSStefano Zampini #endif
122645a1bb75SStefano Zampini   /*
122745a1bb75SStefano Zampini   ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
1228d65f70fdSStefano Zampini   ierr = MatView(new_mat,(PetscViewer)0);CHKERRQ(ierr);
122945a1bb75SStefano Zampini   */
1230d65f70fdSStefano Zampini   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
1231aa0d41d4SStefano Zampini   PetscFunctionReturn(0);
1232aa0d41d4SStefano Zampini }
1233aa0d41d4SStefano Zampini 
1234aa0d41d4SStefano Zampini #undef __FUNCT__
1235a64d13efSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalScatters"
12368ce42a96SStefano Zampini PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
1237a64d13efSStefano Zampini {
1238a64d13efSStefano Zampini   PC_IS*         pcis = (PC_IS*)(pc->data);
1239a64d13efSStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
12408ce42a96SStefano Zampini   IS             is_aux1,is_aux2;
1241e9189074SStefano Zampini   PetscInt       *aux_array1,*aux_array2,*is_indices,*idx_R_local;
12423a50541eSStefano Zampini   PetscInt       n_vertices,i,j,n_R,n_D,n_B;
12433a50541eSStefano Zampini   PetscInt       vbs,bs;
12444641a718SStefano Zampini   PetscBT        bitmask;
1245a64d13efSStefano Zampini   PetscErrorCode ierr;
1246a64d13efSStefano Zampini 
1247a64d13efSStefano Zampini   PetscFunctionBegin;
1248b23d619eSStefano Zampini   /*
1249b23d619eSStefano Zampini     No need to setup local scatters if
1250b23d619eSStefano Zampini       - primal space is unchanged
1251b23d619eSStefano Zampini         AND
1252b23d619eSStefano Zampini       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
1253b23d619eSStefano Zampini         AND
1254b23d619eSStefano Zampini       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
1255b23d619eSStefano Zampini   */
1256b23d619eSStefano Zampini   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
1257f4ddd8eeSStefano Zampini     PetscFunctionReturn(0);
1258f4ddd8eeSStefano Zampini   }
1259f4ddd8eeSStefano Zampini   /* destroy old objects */
1260f4ddd8eeSStefano Zampini   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
1261f4ddd8eeSStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
1262f4ddd8eeSStefano Zampini   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
1263a64d13efSStefano Zampini   /* Set Non-overlapping dimensions */
1264a64d13efSStefano Zampini   n_B = pcis->n_B; n_D = pcis->n - n_B;
1265e9189074SStefano Zampini   n_vertices = pcbddc->n_actual_vertices;
12664641a718SStefano Zampini   /* create auxiliary bitmask */
12674641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
12684641a718SStefano Zampini   for (i=0;i<n_vertices;i++) {
1269e9189074SStefano Zampini     ierr = PetscBTSet(bitmask,pcbddc->primal_indices_local_idxs[i]);CHKERRQ(ierr);
12704641a718SStefano Zampini   }
12713a50541eSStefano Zampini 
1272a64d13efSStefano Zampini   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
1273854ce69bSBarry Smith   ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
1274a64d13efSStefano Zampini   for (i=0, n_R=0; i<pcis->n; i++) {
12754641a718SStefano Zampini     if (!PetscBTLookup(bitmask,i)) {
1276a64d13efSStefano Zampini       idx_R_local[n_R] = i;
1277a64d13efSStefano Zampini       n_R++;
1278a64d13efSStefano Zampini     }
1279a64d13efSStefano Zampini   }
12803a50541eSStefano Zampini 
12813a50541eSStefano Zampini   /* Block code */
12823a50541eSStefano Zampini   vbs = 1;
12833a50541eSStefano Zampini   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
12843a50541eSStefano Zampini   if (bs>1 && !(n_vertices%bs)) {
12853a50541eSStefano Zampini     PetscBool is_blocked = PETSC_TRUE;
12863a50541eSStefano Zampini     PetscInt  *vary;
12873a50541eSStefano Zampini     /* Verify if the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
1288785e854fSJed Brown     ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
12893a50541eSStefano Zampini     ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
1290e9189074SStefano Zampini     for (i=0; i<n_vertices; i++) vary[pcbddc->primal_indices_local_idxs[i]/bs]++;
1291964fefecSStefano Zampini     for (i=0; i<n_vertices/bs; i++) {
12923a50541eSStefano Zampini       if (vary[i]!=0 && vary[i]!=bs) {
12933a50541eSStefano Zampini         is_blocked = PETSC_FALSE;
12943a50541eSStefano Zampini         break;
12953a50541eSStefano Zampini       }
12963a50541eSStefano Zampini     }
12973a50541eSStefano Zampini     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
12983a50541eSStefano Zampini       vbs = bs;
12993a50541eSStefano Zampini       for (i=0;i<n_R/vbs;i++) {
13003a50541eSStefano Zampini         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
13013a50541eSStefano Zampini       }
13023a50541eSStefano Zampini     }
13033a50541eSStefano Zampini     ierr = PetscFree(vary);CHKERRQ(ierr);
13043a50541eSStefano Zampini   }
13053a50541eSStefano Zampini   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
13063a50541eSStefano Zampini   ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
1307a64d13efSStefano Zampini 
1308a64d13efSStefano Zampini   /* print some info if requested */
1309a64d13efSStefano Zampini   if (pcbddc->dbg_flag) {
1310a64d13efSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1311a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
13120fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1313a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
1314a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
13153a50541eSStefano 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);
1316a64d13efSStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"pcbddc->n_vertices = %d, pcbddc->n_constraints = %d\n",pcbddc->n_vertices,pcbddc->n_constraints);CHKERRQ(ierr);
1317a64d13efSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1318a64d13efSStefano Zampini   }
1319a64d13efSStefano Zampini 
1320a64d13efSStefano Zampini   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
13213a50541eSStefano Zampini   ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
1322854ce69bSBarry Smith   ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
1323854ce69bSBarry Smith   ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
1324a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
13254641a718SStefano Zampini   for (i=0; i<n_D; i++) {
13264641a718SStefano Zampini     ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
13274641a718SStefano Zampini   }
1328a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1329a64d13efSStefano Zampini   for (i=0, j=0; i<n_R; i++) {
13304641a718SStefano Zampini     if (!PetscBTLookup(bitmask,idx_R_local[i])) {
13314641a718SStefano Zampini       aux_array1[j++] = i;
1332a64d13efSStefano Zampini     }
1333a64d13efSStefano Zampini   }
1334a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
1335a64d13efSStefano Zampini   ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1336a64d13efSStefano Zampini   for (i=0, j=0; i<n_B; i++) {
13374641a718SStefano Zampini     if (!PetscBTLookup(bitmask,is_indices[i])) {
13384641a718SStefano Zampini       aux_array2[j++] = i;
1339a64d13efSStefano Zampini     }
1340a64d13efSStefano Zampini   }
1341a64d13efSStefano Zampini   ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1342a64d13efSStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
1343a64d13efSStefano Zampini   ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
1344a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
1345a64d13efSStefano Zampini   ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
1346a64d13efSStefano Zampini 
13478eeda7d8SStefano Zampini   if (pcbddc->switch_static || pcbddc->dbg_flag) {
1348785e854fSJed Brown     ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
1349a64d13efSStefano Zampini     for (i=0, j=0; i<n_R; i++) {
13504641a718SStefano Zampini       if (PetscBTLookup(bitmask,idx_R_local[i])) {
13514641a718SStefano Zampini         aux_array1[j++] = i;
1352a64d13efSStefano Zampini       }
1353a64d13efSStefano Zampini     }
1354a64d13efSStefano Zampini     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
1355a64d13efSStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
1356a64d13efSStefano Zampini     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
1357a64d13efSStefano Zampini   }
13584641a718SStefano Zampini   ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
13593a50541eSStefano Zampini   ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
1360a64d13efSStefano Zampini   PetscFunctionReturn(0);
1361a64d13efSStefano Zampini }
1362a64d13efSStefano Zampini 
1363304d26faSStefano Zampini 
1364304d26faSStefano Zampini #undef __FUNCT__
1365304d26faSStefano Zampini #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
1366684f6988SStefano Zampini PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
1367304d26faSStefano Zampini {
1368304d26faSStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1369304d26faSStefano Zampini   PC_IS          *pcis = (PC_IS*)pc->data;
1370304d26faSStefano Zampini   PC             pc_temp;
1371304d26faSStefano Zampini   Mat            A_RR;
1372f4ddd8eeSStefano Zampini   MatReuse       reuse;
1373304d26faSStefano Zampini   PetscScalar    m_one = -1.0;
1374304d26faSStefano Zampini   PetscReal      value;
1375af732b37SStefano Zampini   PetscInt       n_D,n_R,ibs,mbs;
13769577ea80SStefano Zampini   PetscBool      use_exact,use_exact_reduced,issbaij;
1377304d26faSStefano Zampini   PetscErrorCode ierr;
1378e604994aSStefano Zampini   /* prefixes stuff */
1379312be037SStefano Zampini   char           dir_prefix[256],neu_prefix[256],str_level[16];
1380e604994aSStefano Zampini   size_t         len;
1381304d26faSStefano Zampini 
1382304d26faSStefano Zampini   PetscFunctionBegin;
1383304d26faSStefano Zampini 
1384e604994aSStefano Zampini   /* compute prefixes */
1385e604994aSStefano Zampini   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
1386e604994aSStefano Zampini   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
1387e604994aSStefano Zampini   if (!pcbddc->current_level) {
1388e604994aSStefano Zampini     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
1389e604994aSStefano Zampini     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
1390e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
1391e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
1392e604994aSStefano Zampini   } else {
1393e604994aSStefano Zampini     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
1394312be037SStefano Zampini     sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
1395e604994aSStefano Zampini     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
1396e604994aSStefano Zampini     len -= 15; /* remove "pc_bddc_coarse_" */
1397312be037SStefano Zampini     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
1398312be037SStefano Zampini     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
139934d6797cSStefano Zampini     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
140034d6797cSStefano Zampini     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
1401e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
1402e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
1403e604994aSStefano Zampini     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
1404e604994aSStefano Zampini     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
1405e604994aSStefano Zampini   }
1406e604994aSStefano Zampini 
1407304d26faSStefano Zampini   /* DIRICHLET PROBLEM */
1408684f6988SStefano Zampini   if (dirichlet) {
1409964fefecSStefano Zampini     if (pcbddc->issym) {
1410964fefecSStefano Zampini       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
1411964fefecSStefano Zampini     }
1412ac78edfcSStefano Zampini     /* Matrix for Dirichlet problem is pcis->A_II */
1413964fefecSStefano Zampini     n_D = pcis->n - pcis->n_B;
1414304d26faSStefano Zampini     if (!pcbddc->ksp_D) { /* create object if not yet build */
1415304d26faSStefano Zampini       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
1416304d26faSStefano Zampini       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
1417304d26faSStefano Zampini       /* default */
1418304d26faSStefano Zampini       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
1419e604994aSStefano Zampini       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
14209577ea80SStefano Zampini       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
1421304d26faSStefano Zampini       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
14229577ea80SStefano Zampini       if (issbaij) {
14239577ea80SStefano Zampini         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
14249577ea80SStefano Zampini       } else {
1425304d26faSStefano Zampini         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
14269577ea80SStefano Zampini       }
1427304d26faSStefano Zampini       /* Allow user's customization */
1428304d26faSStefano Zampini       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
1429304d26faSStefano Zampini       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1430304d26faSStefano Zampini     }
1431d1e9a80fSBarry Smith     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
1432304d26faSStefano Zampini     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1433304d26faSStefano Zampini     if (!n_D) {
1434304d26faSStefano Zampini       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
1435304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1436304d26faSStefano Zampini     }
1437304d26faSStefano Zampini     /* Set Up KSP for Dirichlet problem of BDDC */
1438304d26faSStefano Zampini     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
1439304d26faSStefano Zampini     /* set ksp_D into pcis data */
1440304d26faSStefano Zampini     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
1441304d26faSStefano Zampini     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
1442304d26faSStefano Zampini     pcis->ksp_D = pcbddc->ksp_D;
1443684f6988SStefano Zampini   }
1444304d26faSStefano Zampini 
1445304d26faSStefano Zampini   /* NEUMANN PROBLEM */
1446684f6988SStefano Zampini   A_RR = 0;
1447684f6988SStefano Zampini   if (neumann) {
1448f4ddd8eeSStefano Zampini     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
14498ce42a96SStefano Zampini     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
1450f4ddd8eeSStefano Zampini     if (pcbddc->ksp_R) { /* already created ksp */
1451f4ddd8eeSStefano Zampini       PetscInt nn_R;
145281d9aea3SBarry Smith       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
1453f4ddd8eeSStefano Zampini       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
1454f4ddd8eeSStefano Zampini       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
1455f4ddd8eeSStefano Zampini       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
1456f4ddd8eeSStefano Zampini         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
1457f4ddd8eeSStefano Zampini         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1458f4ddd8eeSStefano Zampini         reuse = MAT_INITIAL_MATRIX;
1459f4ddd8eeSStefano Zampini       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
1460727cdba6SStefano Zampini         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
1461f4ddd8eeSStefano Zampini           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1462f4ddd8eeSStefano Zampini           reuse = MAT_INITIAL_MATRIX;
1463f4ddd8eeSStefano Zampini         } else { /* safe to reuse the matrix */
1464f4ddd8eeSStefano Zampini           reuse = MAT_REUSE_MATRIX;
1465f4ddd8eeSStefano Zampini         }
1466f4ddd8eeSStefano Zampini       }
1467f4ddd8eeSStefano Zampini       /* last check */
1468d1e9a80fSBarry Smith       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
1469f4ddd8eeSStefano Zampini         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1470f4ddd8eeSStefano Zampini         reuse = MAT_INITIAL_MATRIX;
1471f4ddd8eeSStefano Zampini       }
1472f4ddd8eeSStefano Zampini     } else { /* first time, so we need to create the matrix */
1473f4ddd8eeSStefano Zampini       reuse = MAT_INITIAL_MATRIX;
1474f4ddd8eeSStefano Zampini     }
1475f4ddd8eeSStefano Zampini     /* extract A_RR */
1476af732b37SStefano Zampini     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
1477af732b37SStefano Zampini     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
14783a50541eSStefano Zampini     if (ibs != mbs) {
1479af732b37SStefano Zampini       Mat newmat;
1480af732b37SStefano Zampini       ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INITIAL_MATRIX,&newmat);CHKERRQ(ierr);
1481f4ddd8eeSStefano Zampini       ierr = MatGetSubMatrix(newmat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
1482af732b37SStefano Zampini       ierr = MatDestroy(&newmat);CHKERRQ(ierr);
1483af732b37SStefano Zampini     } else {
1484f4ddd8eeSStefano Zampini       ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
1485af732b37SStefano Zampini     }
1486964fefecSStefano Zampini     if (pcbddc->issym) {
1487964fefecSStefano Zampini       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
1488964fefecSStefano Zampini     }
1489f4ddd8eeSStefano Zampini     if (!pcbddc->ksp_R) { /* create object if not present */
1490304d26faSStefano Zampini       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
1491304d26faSStefano Zampini       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
1492304d26faSStefano Zampini       /* default */
1493304d26faSStefano Zampini       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
1494e604994aSStefano Zampini       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
1495304d26faSStefano Zampini       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
14969577ea80SStefano Zampini       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
14979577ea80SStefano Zampini       if (issbaij) {
14989577ea80SStefano Zampini         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
14999577ea80SStefano Zampini       } else {
1500304d26faSStefano Zampini         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
15019577ea80SStefano Zampini       }
1502304d26faSStefano Zampini       /* Allow user's customization */
1503304d26faSStefano Zampini       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
1504304d26faSStefano Zampini       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
1505304d26faSStefano Zampini     }
1506d1e9a80fSBarry Smith     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
1507304d26faSStefano Zampini     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
1508304d26faSStefano Zampini     if (!n_R) {
1509304d26faSStefano Zampini       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
1510304d26faSStefano Zampini       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
1511304d26faSStefano Zampini     }
1512304d26faSStefano Zampini     /* Set Up KSP for Neumann problem of BDDC */
1513304d26faSStefano Zampini     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
1514684f6988SStefano Zampini   }
1515304d26faSStefano Zampini 
1516304d26faSStefano Zampini   /* check Dirichlet and Neumann solvers and adapt them if a nullspace correction is needed */
15170fccc4e9SStefano Zampini   if (pcbddc->NullSpace || pcbddc->dbg_flag) {
1518684f6988SStefano Zampini     if (pcbddc->dbg_flag) {
1519684f6988SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1520684f6988SStefano Zampini       ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1521684f6988SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
1522684f6988SStefano Zampini     }
1523684f6988SStefano Zampini     if (dirichlet) { /* Dirichlet */
15240fccc4e9SStefano Zampini       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
15250fccc4e9SStefano Zampini       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
15260fccc4e9SStefano Zampini       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
15270fccc4e9SStefano Zampini       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
15280fccc4e9SStefano Zampini       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
1529304d26faSStefano Zampini       /* need to be adapted? */
1530b8ffe317SStefano Zampini       use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1531b8ffe317SStefano Zampini       ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1532b8ffe317SStefano Zampini       ierr = PCBDDCSetUseExactDirichlet(pc,use_exact_reduced);CHKERRQ(ierr);
1533304d26faSStefano Zampini       /* print info */
1534304d26faSStefano Zampini       if (pcbddc->dbg_flag) {
1535e604994aSStefano 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);
1536304d26faSStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1537304d26faSStefano Zampini       }
1538b8ffe317SStefano Zampini       if (pcbddc->NullSpace && !use_exact_reduced && !pcbddc->switch_static) {
15398ce42a96SStefano Zampini         ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcis->is_I_local);CHKERRQ(ierr);
1540304d26faSStefano Zampini       }
1541684f6988SStefano Zampini     }
1542684f6988SStefano Zampini     if (neumann) { /* Neumann */
15430fccc4e9SStefano Zampini       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
15440fccc4e9SStefano Zampini       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
15450fccc4e9SStefano Zampini       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
15460fccc4e9SStefano Zampini       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
15470fccc4e9SStefano Zampini       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
1548304d26faSStefano Zampini       /* need to be adapted? */
1549b8ffe317SStefano Zampini       use_exact = (PetscAbsReal(value) > 1.e-4 ? PETSC_FALSE : PETSC_TRUE);
1550b8ffe317SStefano Zampini       ierr = MPI_Allreduce(&use_exact,&use_exact_reduced,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1551304d26faSStefano Zampini       /* print info */
1552304d26faSStefano Zampini       if (pcbddc->dbg_flag) {
1553e604994aSStefano 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);
1554304d26faSStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1555304d26faSStefano Zampini       }
1556b8ffe317SStefano Zampini       if (pcbddc->NullSpace && !use_exact_reduced) { /* is it the right logic? */
15578ce42a96SStefano Zampini         ierr = PCBDDCNullSpaceAssembleCorrection(pc,pcbddc->is_R_local);CHKERRQ(ierr);
1558304d26faSStefano Zampini       }
15590fccc4e9SStefano Zampini     }
1560684f6988SStefano Zampini   }
1561304d26faSStefano Zampini   /* free Neumann problem's matrix */
1562304d26faSStefano Zampini   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
1563304d26faSStefano Zampini   PetscFunctionReturn(0);
1564304d26faSStefano Zampini }
1565304d26faSStefano Zampini 
1566304d26faSStefano Zampini #undef __FUNCT__
1567ba15a52eSStefano Zampini #define __FUNCT__ "PCBDDCSolveSubstructureCorrection"
156820c7b377SStefano Zampini static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec rhs, Vec sol, Vec work, PetscBool applytranspose)
1569674ae819SStefano Zampini {
1570674ae819SStefano Zampini   PetscErrorCode ierr;
1571674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
1572674ae819SStefano Zampini 
1573674ae819SStefano Zampini   PetscFunctionBegin;
157420c7b377SStefano Zampini   if (applytranspose) {
1575674ae819SStefano Zampini     if (pcbddc->local_auxmat1) {
157620c7b377SStefano Zampini       ierr = MatMultTranspose(pcbddc->local_auxmat2,rhs,work);CHKERRQ(ierr);
157720c7b377SStefano Zampini       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,work,rhs,rhs);CHKERRQ(ierr);
157820c7b377SStefano Zampini     }
157920c7b377SStefano Zampini     ierr = KSPSolveTranspose(pcbddc->ksp_R,rhs,sol);CHKERRQ(ierr);
158020c7b377SStefano Zampini   } else {
158120c7b377SStefano Zampini     ierr = KSPSolve(pcbddc->ksp_R,rhs,sol);CHKERRQ(ierr);
158220c7b377SStefano Zampini     if (pcbddc->local_auxmat1) {
158320c7b377SStefano Zampini       ierr = MatMult(pcbddc->local_auxmat1,sol,work);CHKERRQ(ierr);
158420c7b377SStefano Zampini       ierr = MatMultAdd(pcbddc->local_auxmat2,work,sol,sol);CHKERRQ(ierr);
158520c7b377SStefano Zampini     }
1586674ae819SStefano Zampini   }
1587674ae819SStefano Zampini   PetscFunctionReturn(0);
1588674ae819SStefano Zampini }
1589674ae819SStefano Zampini 
1590dc359a40SStefano Zampini /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
1591674ae819SStefano Zampini #undef __FUNCT__
1592674ae819SStefano Zampini #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
1593dc359a40SStefano Zampini PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
1594674ae819SStefano Zampini {
1595674ae819SStefano Zampini   PetscErrorCode ierr;
1596674ae819SStefano Zampini   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
1597674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)  (pc->data);
1598674ae819SStefano Zampini   const PetscScalar zero = 0.0;
1599674ae819SStefano Zampini 
1600674ae819SStefano Zampini   PetscFunctionBegin;
1601dc359a40SStefano Zampini   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
1602dc359a40SStefano Zampini   if (applytranspose) {
1603674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
16048eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
1605dc359a40SStefano Zampini   } else {
1606674ae819SStefano Zampini     ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
1607674ae819SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
160815aaf578SStefano Zampini   }
160912edc857SStefano Zampini   /* start communications from local primal nodes to rhs of coarse solver */
161012edc857SStefano Zampini   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
161112edc857SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
161212edc857SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
161312edc857SStefano Zampini 
16149f00e9b4SStefano Zampini   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
161512edc857SStefano Zampini   /* TODO remove null space when doing multilevel */
161612edc857SStefano Zampini   if (pcbddc->coarse_ksp) {
1617964fefecSStefano Zampini     Vec rhs,sol;
1618964fefecSStefano Zampini 
1619964fefecSStefano Zampini     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
1620964fefecSStefano Zampini     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
162112edc857SStefano Zampini     if (applytranspose) {
1622964fefecSStefano Zampini       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
162312edc857SStefano Zampini     } else {
1624964fefecSStefano Zampini       ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
162512edc857SStefano Zampini     }
162612edc857SStefano Zampini   }
1627674ae819SStefano Zampini 
1628674ae819SStefano Zampini   /* Local solution on R nodes */
16299f00e9b4SStefano Zampini   if (pcis->n) {
1630674ae819SStefano Zampini     ierr = VecSet(pcbddc->vec1_R,zero);CHKERRQ(ierr);
1631674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1632674ae819SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcis->vec1_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
16338eeda7d8SStefano Zampini     if (pcbddc->switch_static) {
1634674ae819SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1635674ae819SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcis->vec1_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1636674ae819SStefano Zampini     }
163720c7b377SStefano Zampini     ierr = PCBDDCSolveSubstructureCorrection(pc,pcbddc->vec1_R,pcbddc->vec2_R,pcbddc->vec1_C,applytranspose);CHKERRQ(ierr);
1638674ae819SStefano Zampini     ierr = VecSet(pcis->vec1_B,zero);CHKERRQ(ierr);
1639674ae819SStefano Zampini     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1640674ae819SStefano Zampini     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec2_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
16418eeda7d8SStefano Zampini     if (pcbddc->switch_static) {
1642674ae819SStefano Zampini       ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1643674ae819SStefano Zampini       ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec2_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1644674ae819SStefano Zampini     }
16459f00e9b4SStefano Zampini   }
1646674ae819SStefano Zampini 
16479f00e9b4SStefano Zampini   /* communications from coarse sol to local primal nodes */
16489f00e9b4SStefano Zampini   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
164912edc857SStefano Zampini   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1650674ae819SStefano Zampini 
1651674ae819SStefano Zampini   /* Sum contributions from two levels */
1652dc359a40SStefano Zampini   if (applytranspose) {
1653dc359a40SStefano Zampini     ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
1654dc359a40SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1655dc359a40SStefano Zampini   } else {
1656674ae819SStefano Zampini     ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
16578eeda7d8SStefano Zampini     if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
1658dc359a40SStefano Zampini   }
1659674ae819SStefano Zampini   PetscFunctionReturn(0);
1660674ae819SStefano Zampini }
1661674ae819SStefano Zampini 
1662674ae819SStefano Zampini #undef __FUNCT__
1663674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
166412edc857SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
1665674ae819SStefano Zampini {
1666674ae819SStefano Zampini   PetscErrorCode ierr;
1667674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
166858da7f69SStefano Zampini   PetscScalar    *array;
166912edc857SStefano Zampini   Vec            from,to;
1670674ae819SStefano Zampini 
1671674ae819SStefano Zampini   PetscFunctionBegin;
167212edc857SStefano Zampini   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
167312edc857SStefano Zampini     from = pcbddc->coarse_vec;
167412edc857SStefano Zampini     to = pcbddc->vec1_P;
167512edc857SStefano Zampini     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
167612edc857SStefano Zampini       Vec tvec;
167758da7f69SStefano Zampini 
167858da7f69SStefano Zampini       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
167958da7f69SStefano Zampini       ierr = VecResetArray(tvec);CHKERRQ(ierr);
168012edc857SStefano Zampini       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
168158da7f69SStefano Zampini       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
168258da7f69SStefano Zampini       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
168358da7f69SStefano Zampini       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
168412edc857SStefano Zampini     }
168512edc857SStefano Zampini   } else { /* from local to global -> put data in coarse right hand side */
168612edc857SStefano Zampini     from = pcbddc->vec1_P;
168712edc857SStefano Zampini     to = pcbddc->coarse_vec;
168812edc857SStefano Zampini   }
168912edc857SStefano Zampini   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
1690674ae819SStefano Zampini   PetscFunctionReturn(0);
1691674ae819SStefano Zampini }
1692674ae819SStefano Zampini 
1693674ae819SStefano Zampini #undef __FUNCT__
1694674ae819SStefano Zampini #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
169512edc857SStefano Zampini PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
1696674ae819SStefano Zampini {
1697674ae819SStefano Zampini   PetscErrorCode ierr;
1698674ae819SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
169958da7f69SStefano Zampini   PetscScalar    *array;
170012edc857SStefano Zampini   Vec            from,to;
1701674ae819SStefano Zampini 
1702674ae819SStefano Zampini   PetscFunctionBegin;
170312edc857SStefano Zampini   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
170412edc857SStefano Zampini     from = pcbddc->coarse_vec;
170512edc857SStefano Zampini     to = pcbddc->vec1_P;
170612edc857SStefano Zampini   } else { /* from local to global -> put data in coarse right hand side */
170712edc857SStefano Zampini     from = pcbddc->vec1_P;
170812edc857SStefano Zampini     to = pcbddc->coarse_vec;
170912edc857SStefano Zampini   }
171012edc857SStefano Zampini   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
171112edc857SStefano Zampini   if (smode == SCATTER_FORWARD) {
171212edc857SStefano Zampini     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
171312edc857SStefano Zampini       Vec tvec;
171458da7f69SStefano Zampini 
171512edc857SStefano Zampini       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
171658da7f69SStefano Zampini       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
171758da7f69SStefano Zampini       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
171858da7f69SStefano Zampini       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
171958da7f69SStefano Zampini     }
172058da7f69SStefano Zampini   } else {
172158da7f69SStefano Zampini     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
172258da7f69SStefano Zampini      ierr = VecResetArray(from);CHKERRQ(ierr);
172312edc857SStefano Zampini     }
172412edc857SStefano Zampini   }
1725674ae819SStefano Zampini   PetscFunctionReturn(0);
1726674ae819SStefano Zampini }
1727674ae819SStefano Zampini 
1728984c4197SStefano Zampini /* uncomment for testing purposes */
1729984c4197SStefano Zampini /* #define PETSC_MISSING_LAPACK_GESVD 1 */
1730674ae819SStefano Zampini #undef __FUNCT__
1731674ae819SStefano Zampini #define __FUNCT__ "PCBDDCConstraintsSetUp"
1732674ae819SStefano Zampini PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
1733674ae819SStefano Zampini {
1734674ae819SStefano Zampini   PetscErrorCode    ierr;
1735674ae819SStefano Zampini   PC_IS*            pcis = (PC_IS*)(pc->data);
1736674ae819SStefano Zampini   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
1737674ae819SStefano Zampini   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
1738984c4197SStefano Zampini   /* one and zero */
1739984c4197SStefano Zampini   PetscScalar       one=1.0,zero=0.0;
1740984c4197SStefano Zampini   /* space to store constraints and their local indices */
1741984c4197SStefano Zampini   PetscScalar       *temp_quadrature_constraint;
1742984c4197SStefano Zampini   PetscInt          *temp_indices,*temp_indices_to_constraint,*temp_indices_to_constraint_B;
1743984c4197SStefano Zampini   /* iterators */
1744984c4197SStefano Zampini   PetscInt          i,j,k,total_counts,temp_start_ptr;
1745984c4197SStefano Zampini   /* BLAS integers */
1746e310c8b4SStefano Zampini   PetscBLASInt      lwork,lierr;
1747e310c8b4SStefano Zampini   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
1748c4303822SStefano Zampini   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
1749727cdba6SStefano Zampini   /* reuse */
1750727cdba6SStefano Zampini   PetscInt          olocal_primal_size;
1751727cdba6SStefano Zampini   PetscInt          *oprimal_indices_local_idxs;
1752984c4197SStefano Zampini   /* change of basis */
1753984c4197SStefano Zampini   PetscInt          *aux_primal_numbering,*aux_primal_minloc,*global_indices;
1754a717540cSStefano Zampini   PetscBool         boolforchange,qr_needed;
1755a717540cSStefano Zampini   PetscBT           touched,change_basis,qr_needed_idx;
1756984c4197SStefano Zampini   /* auxiliary stuff */
175739e2fb2aSStefano Zampini   PetscInt          *nnz,*is_indices,*aux_primal_numbering_B;
1758a58a30b4SStefano Zampini   PetscInt          ncc,*gidxs=NULL,*permutation=NULL,*temp_indices_to_constraint_work=NULL;
1759a58a30b4SStefano Zampini   PetscScalar       *temp_quadrature_constraint_work=NULL;
1760984c4197SStefano Zampini   /* some quantities */
176145a1bb75SStefano Zampini   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
1762a58a30b4SStefano Zampini   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
1763984c4197SStefano Zampini 
1764674ae819SStefano Zampini   PetscFunctionBegin;
17658e61c736SStefano Zampini   /* Destroy Mat objects computed previously */
17668e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
17678e61c736SStefano Zampini   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
1768cf5a6209SStefano Zampini 
1769cf5a6209SStefano Zampini   /* print some info */
1770cf5a6209SStefano Zampini   if (pcbddc->dbg_flag) {
1771cf5a6209SStefano Zampini     IS       vertices;
1772cf5a6209SStefano Zampini     PetscInt nv,nedges,nfaces;
1773cf5a6209SStefano Zampini     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
1774cf5a6209SStefano Zampini     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
1775cf5a6209SStefano Zampini     ierr = ISDestroy(&vertices);CHKERRQ(ierr);
1776cf5a6209SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
1777cf5a6209SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
1778cf5a6209SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
1779fd14bc51SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
1780fd14bc51SStefano Zampini     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
1781cf5a6209SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
1782cf5a6209SStefano Zampini   }
1783cf5a6209SStefano Zampini 
1784cf5a6209SStefano Zampini   if (!pcbddc->adaptive_selection) {
1785cf5a6209SStefano Zampini     IS           ISForVertices,*ISForFaces,*ISForEdges,*used_IS;
1786cf5a6209SStefano Zampini     MatNullSpace nearnullsp;
1787cf5a6209SStefano Zampini     const Vec    *nearnullvecs;
1788cf5a6209SStefano Zampini     Vec          *localnearnullsp;
1789cf5a6209SStefano Zampini     PetscScalar  *array;
1790cf5a6209SStefano Zampini     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
1791cf5a6209SStefano Zampini     PetscBool    nnsp_has_cnst;
1792cf5a6209SStefano Zampini     /* LAPACK working arrays for SVD or POD */
1793cf5a6209SStefano Zampini     PetscBool    skip_lapack;
1794cf5a6209SStefano Zampini     PetscScalar  *work;
1795cf5a6209SStefano Zampini     PetscReal    *singular_vals;
1796cf5a6209SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1797cf5a6209SStefano Zampini     PetscReal    *rwork;
1798cf5a6209SStefano Zampini #endif
1799cf5a6209SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1800cf5a6209SStefano Zampini     PetscScalar  *temp_basis,*correlation_mat;
1801cf5a6209SStefano Zampini #else
1802964fefecSStefano Zampini     PetscBLASInt dummy_int=1;
1803964fefecSStefano Zampini     PetscScalar  dummy_scalar=1.;
1804cf5a6209SStefano Zampini #endif
1805cf5a6209SStefano Zampini 
1806674ae819SStefano Zampini     /* Get index sets for faces, edges and vertices from graph */
1807d06fc5fdSStefano Zampini     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
1808d06fc5fdSStefano Zampini     /* free unneeded index sets */
1809d06fc5fdSStefano Zampini     if (!pcbddc->use_vertices) {
1810d06fc5fdSStefano Zampini       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
1811674ae819SStefano Zampini     }
1812d06fc5fdSStefano Zampini     if (!pcbddc->use_edges) {
1813d06fc5fdSStefano Zampini       for (i=0;i<n_ISForEdges;i++) {
1814d06fc5fdSStefano Zampini         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
1815d06fc5fdSStefano Zampini       }
1816d06fc5fdSStefano Zampini       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
1817d06fc5fdSStefano Zampini       n_ISForEdges = 0;
1818d06fc5fdSStefano Zampini     }
1819d06fc5fdSStefano Zampini     if (!pcbddc->use_faces) {
1820d06fc5fdSStefano Zampini       for (i=0;i<n_ISForFaces;i++) {
1821d06fc5fdSStefano Zampini         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
1822d06fc5fdSStefano Zampini       }
1823d06fc5fdSStefano Zampini       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
1824d06fc5fdSStefano Zampini       n_ISForFaces = 0;
1825d06fc5fdSStefano Zampini     }
1826d06fc5fdSStefano Zampini     /* HACKS (the following two blocks of code) */
1827b9b85e73SStefano Zampini     if (!ISForVertices && pcbddc->NullSpace && !pcbddc->user_ChangeOfBasisMatrix) {
1828b8ffe317SStefano Zampini       pcbddc->use_change_of_basis = PETSC_TRUE;
1829d06fc5fdSStefano Zampini       if (!ISForEdges) {
1830d06fc5fdSStefano Zampini         pcbddc->use_change_on_faces = PETSC_TRUE;
1831d06fc5fdSStefano Zampini       }
1832b8ffe317SStefano Zampini     }
183398a51de6SStefano Zampini     if (pcbddc->NullSpace) {
183498a51de6SStefano Zampini       /* use_change_of_basis should be consistent among processors */
1835d06fc5fdSStefano Zampini       PetscBool tbool[2],gbool[2];
1836d06fc5fdSStefano Zampini       tbool [0] = pcbddc->use_change_of_basis;
1837d06fc5fdSStefano Zampini       tbool [1] = pcbddc->use_change_on_faces;
1838d06fc5fdSStefano Zampini       ierr = MPI_Allreduce(tbool,gbool,2,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
1839d06fc5fdSStefano Zampini       pcbddc->use_change_of_basis = gbool[0];
1840d06fc5fdSStefano Zampini       pcbddc->use_change_on_faces = gbool[1];
184198a51de6SStefano Zampini     }
184208122e43SStefano Zampini 
1843674ae819SStefano Zampini     /* check if near null space is attached to global mat */
1844674ae819SStefano Zampini     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
1845674ae819SStefano Zampini     if (nearnullsp) {
1846674ae819SStefano Zampini       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
1847f4ddd8eeSStefano Zampini       /* remove any stored info */
1848f4ddd8eeSStefano Zampini       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
1849f4ddd8eeSStefano Zampini       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1850f4ddd8eeSStefano Zampini       /* store information for BDDC solver reuse */
1851f4ddd8eeSStefano Zampini       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
1852f4ddd8eeSStefano Zampini       pcbddc->onearnullspace = nearnullsp;
1853473ba861SJed Brown       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
1854f4ddd8eeSStefano Zampini       for (i=0;i<nnsp_size;i++) {
1855f4ddd8eeSStefano Zampini         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
1856f4ddd8eeSStefano Zampini       }
1857984c4197SStefano Zampini     } else { /* if near null space is not provided BDDC uses constants by default */
1858984c4197SStefano Zampini       nnsp_size = 0;
1859674ae819SStefano Zampini       nnsp_has_cnst = PETSC_TRUE;
1860674ae819SStefano Zampini     }
1861984c4197SStefano Zampini     /* get max number of constraints on a single cc */
1862984c4197SStefano Zampini     max_constraints = nnsp_size;
1863984c4197SStefano Zampini     if (nnsp_has_cnst) max_constraints++;
1864984c4197SStefano Zampini 
1865674ae819SStefano Zampini     /*
1866674ae819SStefano Zampini          Evaluate maximum storage size needed by the procedure
1867674ae819SStefano Zampini          - temp_indices will contain start index of each constraint stored as follows
1868911cabfeSStefano 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
1869911cabfeSStefano 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
1870911cabfeSStefano Zampini          - temp_quadrature_constraint  [temp_indices[i],...,temp_indices[i+1]-1] will contain the scalars representing the constraint itself
1871674ae819SStefano Zampini                                                                                                                                                            */
1872674ae819SStefano Zampini     total_counts = n_ISForFaces+n_ISForEdges;
1873984c4197SStefano Zampini     total_counts *= max_constraints;
1874674ae819SStefano Zampini     n_vertices = 0;
1875674ae819SStefano Zampini     if (ISForVertices) {
1876674ae819SStefano Zampini       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
1877674ae819SStefano Zampini     }
1878674ae819SStefano Zampini     total_counts += n_vertices;
1879854ce69bSBarry Smith     ierr = PetscMalloc1(total_counts+1,&temp_indices);CHKERRQ(ierr);
18804641a718SStefano Zampini     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
1881674ae819SStefano Zampini     total_counts = 0;
1882674ae819SStefano Zampini     max_size_of_constraint = 0;
1883674ae819SStefano Zampini     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
1884674ae819SStefano Zampini       if (i<n_ISForEdges) {
1885674ae819SStefano Zampini         used_IS = &ISForEdges[i];
1886674ae819SStefano Zampini       } else {
1887674ae819SStefano Zampini         used_IS = &ISForFaces[i-n_ISForEdges];
1888674ae819SStefano Zampini       }
1889674ae819SStefano Zampini       ierr = ISGetSize(*used_IS,&j);CHKERRQ(ierr);
1890674ae819SStefano Zampini       total_counts += j;
1891674ae819SStefano Zampini       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
1892674ae819SStefano Zampini     }
1893984c4197SStefano Zampini     total_counts *= max_constraints;
1894674ae819SStefano Zampini     total_counts += n_vertices;
1895906d46d4SStefano Zampini     ierr = PetscMalloc3(total_counts,&temp_quadrature_constraint,total_counts,&temp_indices_to_constraint,total_counts,&temp_indices_to_constraint_B);CHKERRQ(ierr);
1896984c4197SStefano Zampini     /* get local part of global near null space vectors */
1897785e854fSJed Brown     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
1898984c4197SStefano Zampini     for (k=0;k<nnsp_size;k++) {
1899984c4197SStefano Zampini       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
1900984c4197SStefano Zampini       ierr = VecScatterBegin(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1901984c4197SStefano Zampini       ierr = VecScatterEnd(matis->ctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1902984c4197SStefano Zampini     }
1903674ae819SStefano Zampini 
1904242a89d7SStefano Zampini     /* whether or not to skip lapack calls */
1905242a89d7SStefano Zampini     skip_lapack = PETSC_TRUE;
1906a773dcb8SStefano Zampini     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
1907242a89d7SStefano Zampini 
19088f1c130eSStefano Zampini     /* allocate some auxiliary stuff */
19098f1c130eSStefano Zampini     if (!skip_lapack || pcbddc->use_qr_single) {
19108f1c130eSStefano 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);
1911f9208b2eSJed Brown     } else {
1912f9208b2eSJed Brown       gidxs = NULL;
1913f9208b2eSJed Brown       permutation = NULL;
1914f9208b2eSJed Brown       temp_indices_to_constraint_work = NULL;
1915f9208b2eSJed Brown       temp_quadrature_constraint_work = NULL;
19168f1c130eSStefano Zampini     }
19178f1c130eSStefano Zampini 
1918984c4197SStefano Zampini     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
1919a773dcb8SStefano Zampini     if (!skip_lapack) {
1920674ae819SStefano Zampini       PetscScalar temp_work;
1921911cabfeSStefano Zampini 
1922674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
1923984c4197SStefano Zampini       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
1924785e854fSJed Brown       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
1925785e854fSJed Brown       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
1926785e854fSJed Brown       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
1927674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1928785e854fSJed Brown       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
1929674ae819SStefano Zampini #endif
1930674ae819SStefano Zampini       /* now we evaluate the optimal workspace using query with lwork=-1 */
1931c8244a33SStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
1932c8244a33SStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
1933674ae819SStefano Zampini       lwork = -1;
1934674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1935674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1936c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
1937674ae819SStefano Zampini #else
1938c8244a33SStefano Zampini       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
1939674ae819SStefano Zampini #endif
1940674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1941984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
1942674ae819SStefano Zampini #else /* on missing GESVD */
1943674ae819SStefano Zampini       /* SVD */
1944674ae819SStefano Zampini       PetscInt max_n,min_n;
1945674ae819SStefano Zampini       max_n = max_size_of_constraint;
1946984c4197SStefano Zampini       min_n = max_constraints;
1947984c4197SStefano Zampini       if (max_size_of_constraint < max_constraints) {
1948674ae819SStefano Zampini         min_n = max_size_of_constraint;
1949984c4197SStefano Zampini         max_n = max_constraints;
1950674ae819SStefano Zampini       }
1951785e854fSJed Brown       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
1952674ae819SStefano Zampini #if defined(PETSC_USE_COMPLEX)
1953785e854fSJed Brown       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
1954674ae819SStefano Zampini #endif
1955674ae819SStefano Zampini       /* now we evaluate the optimal workspace using query with lwork=-1 */
1956674ae819SStefano Zampini       lwork = -1;
1957e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
1958e310c8b4SStefano Zampini       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
1959b7d8b9f8SStefano Zampini       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
1960674ae819SStefano Zampini       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
1961674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
1962cf5a6209SStefano 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));
1963674ae819SStefano Zampini #else
1964cf5a6209SStefano 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));
1965674ae819SStefano Zampini #endif
1966674ae819SStefano Zampini       ierr = PetscFPTrapPop();CHKERRQ(ierr);
1967984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
1968984c4197SStefano Zampini #endif /* on missing GESVD */
1969674ae819SStefano Zampini       /* Allocate optimal workspace */
1970674ae819SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
1971854ce69bSBarry Smith       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
1972674ae819SStefano Zampini     }
1973674ae819SStefano Zampini     /* Now we can loop on constraining sets */
1974674ae819SStefano Zampini     total_counts = 0;
1975674ae819SStefano Zampini     temp_indices[0] = 0;
1976674ae819SStefano Zampini     /* vertices */
1977674ae819SStefano Zampini     if (ISForVertices) {
1978674ae819SStefano Zampini       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1979674ae819SStefano Zampini       if (nnsp_has_cnst) { /* consider all vertices */
198039e2fb2aSStefano Zampini         ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
1981674ae819SStefano Zampini         for (i=0;i<n_vertices;i++) {
1982674ae819SStefano Zampini           temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1983674ae819SStefano Zampini           temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1984674ae819SStefano Zampini           total_counts++;
1985674ae819SStefano Zampini         }
1986674ae819SStefano Zampini       } else { /* consider vertices for which exist at least a localnearnullsp which is not null there */
1987984c4197SStefano Zampini         PetscBool used_vertex;
1988674ae819SStefano Zampini         for (i=0;i<n_vertices;i++) {
1989674ae819SStefano Zampini           used_vertex = PETSC_FALSE;
1990674ae819SStefano Zampini           k = 0;
1991674ae819SStefano Zampini           while (!used_vertex && k<nnsp_size) {
1992984c4197SStefano Zampini             ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
1993984c4197SStefano Zampini             if (PetscAbsScalar(array[is_indices[i]])>0.0) {
1994674ae819SStefano Zampini               temp_indices_to_constraint[temp_indices[total_counts]]=is_indices[i];
1995674ae819SStefano Zampini               temp_quadrature_constraint[temp_indices[total_counts]]=1.0;
1996674ae819SStefano Zampini               temp_indices[total_counts+1]=temp_indices[total_counts]+1;
1997674ae819SStefano Zampini               total_counts++;
1998674ae819SStefano Zampini               used_vertex = PETSC_TRUE;
1999674ae819SStefano Zampini             }
2000984c4197SStefano Zampini             ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
2001674ae819SStefano Zampini             k++;
2002674ae819SStefano Zampini           }
2003674ae819SStefano Zampini         }
2004674ae819SStefano Zampini       }
2005674ae819SStefano Zampini       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2006674ae819SStefano Zampini       n_vertices = total_counts;
2007674ae819SStefano Zampini     }
2008984c4197SStefano Zampini 
2009674ae819SStefano Zampini     /* edges and faces */
2010911cabfeSStefano Zampini     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
2011911cabfeSStefano Zampini       if (ncc<n_ISForEdges) {
2012911cabfeSStefano Zampini         used_IS = &ISForEdges[ncc];
2013984c4197SStefano Zampini         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
2014674ae819SStefano Zampini       } else {
2015911cabfeSStefano Zampini         used_IS = &ISForFaces[ncc-n_ISForEdges];
2016984c4197SStefano Zampini         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
2017674ae819SStefano Zampini       }
2018674ae819SStefano Zampini       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
2019674ae819SStefano Zampini       temp_start_ptr = total_counts; /* need to know the starting index of constraints stored */
2020674ae819SStefano Zampini       ierr = ISGetSize(*used_IS,&size_of_constraint);CHKERRQ(ierr);
2021674ae819SStefano Zampini       ierr = ISGetIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
2022984c4197SStefano Zampini       /* change of basis should not be performed on local periodic nodes */
2023984c4197SStefano Zampini       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
2024674ae819SStefano Zampini       if (nnsp_has_cnst) {
20255b08dc53SStefano Zampini         PetscScalar quad_value;
2026674ae819SStefano Zampini         temp_constraints++;
2027a773dcb8SStefano Zampini         if (!pcbddc->use_nnsp_true) {
2028674ae819SStefano Zampini           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
2029a773dcb8SStefano Zampini         } else {
2030a773dcb8SStefano Zampini           quad_value = 1.0;
2031a773dcb8SStefano Zampini         }
203239e2fb2aSStefano Zampini         ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
2033674ae819SStefano Zampini         for (j=0;j<size_of_constraint;j++) {
2034674ae819SStefano Zampini           temp_quadrature_constraint[temp_indices[total_counts]+j]=quad_value;
2035674ae819SStefano Zampini         }
203608122e43SStefano Zampini         /* sort by global ordering if using lapack subroutines (not needed!) */
20378f1c130eSStefano Zampini         if (!skip_lapack || pcbddc->use_qr_single) {
2038911cabfeSStefano Zampini           ierr = ISLocalToGlobalMappingApply(matis->mapping,size_of_constraint,temp_indices_to_constraint+temp_indices[total_counts],gidxs);CHKERRQ(ierr);
2039911cabfeSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
2040911cabfeSStefano Zampini             permutation[j]=j;
2041911cabfeSStefano Zampini           }
2042911cabfeSStefano Zampini           ierr = PetscSortIntWithPermutation(size_of_constraint,gidxs,permutation);CHKERRQ(ierr);
2043911cabfeSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
204408122e43SStefano Zampini             if (permutation[j]!=j) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"This should not happen");
204508122e43SStefano Zampini           }
204608122e43SStefano Zampini           for (j=0;j<size_of_constraint;j++) {
2047911cabfeSStefano Zampini             temp_indices_to_constraint_work[j] = temp_indices_to_constraint[temp_indices[total_counts]+permutation[j]];
2048911cabfeSStefano Zampini             temp_quadrature_constraint_work[j] = temp_quadrature_constraint[temp_indices[total_counts]+permutation[j]];
2049911cabfeSStefano Zampini           }
2050911cabfeSStefano Zampini           ierr = PetscMemcpy(temp_indices_to_constraint+temp_indices[total_counts],temp_indices_to_constraint_work,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
2051911cabfeSStefano Zampini           ierr = PetscMemcpy(temp_quadrature_constraint+temp_indices[total_counts],temp_quadrature_constraint_work,size_of_constraint*sizeof(PetscScalar));CHKERRQ(ierr);
2052911cabfeSStefano Zampini         }
2053674ae819SStefano Zampini         temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
2054674ae819SStefano Zampini         total_counts++;
2055674ae819SStefano Zampini       }
2056674ae819SStefano Zampini       for (k=0;k<nnsp_size;k++) {
2057984c4197SStefano Zampini         PetscReal real_value;
2058984c4197SStefano Zampini         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
205939e2fb2aSStefano Zampini         ierr = PetscMemcpy(&temp_indices_to_constraint[temp_indices[total_counts]],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
2060674ae819SStefano Zampini         for (j=0;j<size_of_constraint;j++) {
2061984c4197SStefano Zampini           temp_quadrature_constraint[temp_indices[total_counts]+j]=array[is_indices[j]];
2062674ae819SStefano Zampini         }
2063984c4197SStefano Zampini         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
2064984c4197SStefano Zampini         /* check if array is null on the connected component */
2065e310c8b4SStefano Zampini         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2066e310c8b4SStefano Zampini         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,&temp_quadrature_constraint[temp_indices[total_counts]],&Blas_one));
20675b08dc53SStefano Zampini         if (real_value > 0.0) { /* keep indices and values */
2068911cabfeSStefano Zampini           /* sort by global ordering if using lapack subroutines */
20698f1c130eSStefano Zampini           if (!skip_lapack || pcbddc->use_qr_single) {
2070911cabfeSStefano Zampini             ierr = ISLocalToGlobalMappingApply(matis->mapping,size_of_constraint,temp_indices_to_constraint+temp_indices[total_counts],gidxs);CHKERRQ(ierr);
2071911cabfeSStefano Zampini             for (j=0;j<size_of_constraint;j++) {
2072911cabfeSStefano Zampini               permutation[j]=j;
2073911cabfeSStefano Zampini             }
2074911cabfeSStefano Zampini             ierr = PetscSortIntWithPermutation(size_of_constraint,gidxs,permutation);CHKERRQ(ierr);
2075911cabfeSStefano Zampini             for (j=0;j<size_of_constraint;j++) {
2076911cabfeSStefano Zampini               temp_indices_to_constraint_work[j] = temp_indices_to_constraint[temp_indices[total_counts]+permutation[j]];
2077911cabfeSStefano Zampini               temp_quadrature_constraint_work[j] = temp_quadrature_constraint[temp_indices[total_counts]+permutation[j]];
2078911cabfeSStefano Zampini             }
2079911cabfeSStefano Zampini             ierr = PetscMemcpy(temp_indices_to_constraint+temp_indices[total_counts],temp_indices_to_constraint_work,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
2080911cabfeSStefano Zampini             ierr = PetscMemcpy(temp_quadrature_constraint+temp_indices[total_counts],temp_quadrature_constraint_work,size_of_constraint*sizeof(PetscScalar));CHKERRQ(ierr);
2081911cabfeSStefano Zampini           }
2082674ae819SStefano Zampini           temp_constraints++;
2083674ae819SStefano Zampini           temp_indices[total_counts+1]=temp_indices[total_counts]+size_of_constraint;  /* store new starting point */
2084674ae819SStefano Zampini           total_counts++;
2085674ae819SStefano Zampini         }
2086674ae819SStefano Zampini       }
2087674ae819SStefano Zampini       ierr = ISRestoreIndices(*used_IS,(const PetscInt**)&is_indices);CHKERRQ(ierr);
208845a1bb75SStefano Zampini       valid_constraints = temp_constraints;
2089eb97c9d2SStefano Zampini       if (!pcbddc->use_nnsp_true && temp_constraints) {
2090a773dcb8SStefano Zampini         if (temp_constraints == 1) { /* just normalize the constraint */
2091a773dcb8SStefano Zampini           PetscScalar norm;
2092a773dcb8SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2093a773dcb8SStefano 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));
2094a773dcb8SStefano Zampini           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
2095a773dcb8SStefano Zampini           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,temp_quadrature_constraint+temp_indices[temp_start_ptr],&Blas_one));
2096a773dcb8SStefano Zampini         } else { /* perform SVD */
2097984c4197SStefano Zampini           PetscReal tol = 1.0e-8; /* tolerance for retaining eigenmodes */
2098674ae819SStefano Zampini 
2099674ae819SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
2100984c4197SStefano Zampini           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
2101984c4197SStefano Zampini              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
2102984c4197SStefano Zampini              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
2103984c4197SStefano Zampini                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
2104984c4197SStefano Zampini                 from that computed using LAPACKgesvd
2105984c4197SStefano Zampini              -> This is due to a different computation of eigenvectors in LAPACKheev
2106984c4197SStefano Zampini              -> The quality of the POD-computed basis will be the same */
2107984c4197SStefano Zampini           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
2108674ae819SStefano Zampini           /* Store upper triangular part of correlation matrix */
2109e310c8b4SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2110984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2111674ae819SStefano Zampini           for (j=0;j<temp_constraints;j++) {
2112674ae819SStefano Zampini             for (k=0;k<j+1;k++) {
2113cf5a6209SStefano 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));
2114674ae819SStefano Zampini             }
2115674ae819SStefano Zampini           }
2116e310c8b4SStefano Zampini           /* compute eigenvalues and eigenvectors of correlation matrix */
2117e310c8b4SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
2118e310c8b4SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
2119674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
2120c8244a33SStefano Zampini           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
2121674ae819SStefano Zampini #else
2122c8244a33SStefano Zampini           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
2123674ae819SStefano Zampini #endif
2124674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2125984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
2126984c4197SStefano Zampini           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
2127674ae819SStefano Zampini           j = 0;
2128984c4197SStefano Zampini           while (j < temp_constraints && singular_vals[j] < tol) j++;
2129674ae819SStefano Zampini           total_counts = total_counts-j;
213045a1bb75SStefano Zampini           valid_constraints = temp_constraints-j;
2131e310c8b4SStefano Zampini           /* scale and copy POD basis into used quadrature memory */
2132c4303822SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
2133c4303822SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
2134c4303822SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
2135c4303822SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2136c4303822SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
2137c4303822SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
2138674ae819SStefano Zampini           if (j<temp_constraints) {
2139984c4197SStefano Zampini             PetscInt ii;
2140984c4197SStefano Zampini             for (k=j;k<temp_constraints;k++) singular_vals[k]=1.0/PetscSqrtReal(singular_vals[k]);
2141674ae819SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2142c4303822SStefano 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));
2143674ae819SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
2144984c4197SStefano Zampini             for (k=0;k<temp_constraints-j;k++) {
2145674ae819SStefano Zampini               for (ii=0;ii<size_of_constraint;ii++) {
2146984c4197SStefano 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];
2147674ae819SStefano Zampini               }
2148674ae819SStefano Zampini             }
2149674ae819SStefano Zampini           }
2150674ae819SStefano Zampini #else  /* on missing GESVD */
2151e310c8b4SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
2152e310c8b4SStefano Zampini           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
2153b7d8b9f8SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2154674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2155674ae819SStefano Zampini #if !defined(PETSC_USE_COMPLEX)
2156cf5a6209SStefano 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));
2157674ae819SStefano Zampini #else
2158cf5a6209SStefano 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));
2159674ae819SStefano Zampini #endif
2160984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
2161674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2162984c4197SStefano Zampini           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
2163e310c8b4SStefano Zampini           k = temp_constraints;
2164e310c8b4SStefano Zampini           if (k > size_of_constraint) k = size_of_constraint;
2165674ae819SStefano Zampini           j = 0;
2166e310c8b4SStefano Zampini           while (j < k && singular_vals[k-j-1] < tol) j++;
216745a1bb75SStefano Zampini           valid_constraints = k-j;
2168911cabfeSStefano Zampini           total_counts = total_counts-temp_constraints+valid_constraints;
2169984c4197SStefano Zampini #endif /* on missing GESVD */
2170674ae819SStefano Zampini         }
2171a773dcb8SStefano Zampini       }
217245a1bb75SStefano Zampini       /* setting change_of_basis flag is safe now */
217345a1bb75SStefano Zampini       if (boolforchange) {
217445a1bb75SStefano Zampini         for (j=0;j<valid_constraints;j++) {
217545a1bb75SStefano Zampini           PetscBTSet(change_basis,total_counts-j-1);
217645a1bb75SStefano Zampini         }
217745a1bb75SStefano Zampini       }
2178674ae819SStefano Zampini     }
2179984c4197SStefano Zampini     /* free workspace */
21808f1c130eSStefano Zampini     if (!skip_lapack || pcbddc->use_qr_single) {
2181911cabfeSStefano Zampini       ierr = PetscFree4(gidxs,permutation,temp_indices_to_constraint_work,temp_quadrature_constraint_work);CHKERRQ(ierr);
21828f1c130eSStefano Zampini     }
21838f1c130eSStefano Zampini     if (!skip_lapack) {
2184984c4197SStefano Zampini       ierr = PetscFree(work);CHKERRQ(ierr);
2185984c4197SStefano Zampini #if defined(PETSC_USE_COMPLEX)
2186984c4197SStefano Zampini       ierr = PetscFree(rwork);CHKERRQ(ierr);
2187984c4197SStefano Zampini #endif
2188984c4197SStefano Zampini       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
2189984c4197SStefano Zampini #if defined(PETSC_MISSING_LAPACK_GESVD)
2190984c4197SStefano Zampini       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
2191984c4197SStefano Zampini       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
2192984c4197SStefano Zampini #endif
2193984c4197SStefano Zampini     }
2194984c4197SStefano Zampini     for (k=0;k<nnsp_size;k++) {
2195984c4197SStefano Zampini       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
2196984c4197SStefano Zampini     }
2197984c4197SStefano Zampini     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
2198cf5a6209SStefano Zampini     /* free index sets of faces, edges and vertices */
2199cf5a6209SStefano Zampini     for (i=0;i<n_ISForFaces;i++) {
2200cf5a6209SStefano Zampini       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
2201cf5a6209SStefano Zampini     }
2202cf5a6209SStefano Zampini     if (n_ISForFaces) {
2203cf5a6209SStefano Zampini       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
2204cf5a6209SStefano Zampini     }
2205cf5a6209SStefano Zampini     for (i=0;i<n_ISForEdges;i++) {
2206cf5a6209SStefano Zampini       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
2207cf5a6209SStefano Zampini     }
2208cf5a6209SStefano Zampini     if (n_ISForEdges) {
2209cf5a6209SStefano Zampini       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
2210cf5a6209SStefano Zampini     }
2211cf5a6209SStefano Zampini     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
221208122e43SStefano Zampini   } else {
221308122e43SStefano Zampini     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
221408122e43SStefano Zampini     PetscInt        cum = 0;
221508122e43SStefano Zampini 
221608122e43SStefano Zampini     total_counts = 0;
221708122e43SStefano Zampini     n_vertices = 0;
221808122e43SStefano Zampini     if (sub_schurs->is_Ej_com) {
221908122e43SStefano Zampini       ierr = ISGetLocalSize(sub_schurs->is_Ej_com,&n_vertices);CHKERRQ(ierr);
222008122e43SStefano Zampini     }
222108122e43SStefano Zampini     max_constraints = 0;
222208122e43SStefano Zampini     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
222308122e43SStefano Zampini       total_counts += pcbddc->adaptive_constraints_n[i];
222408122e43SStefano Zampini       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
222508122e43SStefano Zampini     }
222608122e43SStefano Zampini     temp_indices = pcbddc->adaptive_constraints_ptrs;
222708122e43SStefano Zampini     temp_indices_to_constraint = pcbddc->adaptive_constraints_idxs;
222808122e43SStefano Zampini     temp_quadrature_constraint = pcbddc->adaptive_constraints_data;
222908122e43SStefano Zampini 
223008122e43SStefano Zampini #if 0
223108122e43SStefano Zampini     printf("Found %d totals\n",total_counts);
223208122e43SStefano Zampini     for (i=0;i<total_counts;i++) {
223308122e43SStefano Zampini       printf("const %d, start %d",i,temp_indices[i]);
223408122e43SStefano Zampini       printf(" end %d:\n",temp_indices[i+1]);
223508122e43SStefano Zampini       for (j=temp_indices[i];j<temp_indices[i+1];j++) {
223608122e43SStefano Zampini         printf("  idxs %d",temp_indices_to_constraint[j]);
223708122e43SStefano Zampini         printf("  data %1.2e\n",temp_quadrature_constraint[j]);
223808122e43SStefano Zampini       }
223908122e43SStefano Zampini     }
22401b968477SStefano Zampini     for (i=0;i<n_vertices;i++) {
22411b968477SStefano Zampini       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i+n_vertices]);
22421b968477SStefano Zampini     }
22431b968477SStefano Zampini     for (i=0;i<sub_schurs->n_subs;i++) {
22441b968477SStefano Zampini       PetscPrintf(PETSC_COMM_SELF,"[%d] sub %d, edge %d, n %d\n",PetscGlobalRank,i,PetscBTLookup(sub_schurs->is_edge,i),pcbddc->adaptive_constraints_n[i+n_vertices]);
22451b968477SStefano Zampini     }
224608122e43SStefano Zampini #endif
224708122e43SStefano Zampini 
224808122e43SStefano Zampini     for (i=0;i<total_counts;i++) max_size_of_constraint = PetscMax(max_size_of_constraint,temp_indices[i+1]-temp_indices[i]);
224908122e43SStefano Zampini     ierr = PetscMalloc1(temp_indices[total_counts],&temp_indices_to_constraint_B);CHKERRQ(ierr);
225008122e43SStefano Zampini     /* Change of basis */
225108122e43SStefano Zampini     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
225208122e43SStefano Zampini     if (pcbddc->use_change_of_basis) {
2253bbb9e6c6SStefano Zampini       cum = n_vertices;
225408122e43SStefano Zampini       for (i=0;i<sub_schurs->n_subs;i++) {
225508122e43SStefano Zampini         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
2256bbb9e6c6SStefano Zampini           for (j=0;j<pcbddc->adaptive_constraints_n[i+n_vertices];j++) {
225708122e43SStefano Zampini             ierr = PetscBTSet(change_basis,cum+j);CHKERRQ(ierr);
225808122e43SStefano Zampini           }
225908122e43SStefano Zampini         }
2260bbb9e6c6SStefano Zampini         cum += pcbddc->adaptive_constraints_n[i+n_vertices];
226108122e43SStefano Zampini       }
226208122e43SStefano Zampini     }
226308122e43SStefano Zampini   }
226408122e43SStefano Zampini 
226508122e43SStefano Zampini   /* map temp_indices_to_constraint in boundary numbering */
226608122e43SStefano Zampini   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,temp_indices[total_counts],temp_indices_to_constraint,&i,temp_indices_to_constraint_B);CHKERRQ(ierr);
226708122e43SStefano Zampini   if (i != temp_indices[total_counts]) {
226808122e43SStefano Zampini     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for constraints indices %d != %d\n",temp_indices[total_counts],i);
226908122e43SStefano Zampini   }
2270984c4197SStefano Zampini 
2271727cdba6SStefano Zampini   /* set quantities in pcbddc data structure and store previous primal size */
2272984c4197SStefano Zampini   /* n_vertices defines the number of subdomain corners in the primal space */
2273674ae819SStefano Zampini   /* n_constraints defines the number of averages (they can be point primal dofs if change of basis is requested) */
2274727cdba6SStefano Zampini   olocal_primal_size = pcbddc->local_primal_size;
2275984c4197SStefano Zampini   pcbddc->local_primal_size = total_counts;
2276674ae819SStefano Zampini   pcbddc->n_vertices = n_vertices;
2277984c4197SStefano Zampini   pcbddc->n_constraints = pcbddc->local_primal_size-pcbddc->n_vertices;
2278674ae819SStefano Zampini 
2279674ae819SStefano Zampini   /* Create constraint matrix */
2280674ae819SStefano Zampini   /* The constraint matrix is used to compute the l2g map of primal dofs */
2281674ae819SStefano Zampini   /* so we need to set it up properly either with or without change of basis */
2282674ae819SStefano Zampini   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
228316f15bc4SStefano Zampini   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
2284984c4197SStefano Zampini   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
2285984c4197SStefano Zampini   /* array to compute a local numbering of constraints : vertices first then constraints */
2286785e854fSJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&aux_primal_numbering);CHKERRQ(ierr);
2287984c4197SStefano Zampini   /* array to select the proper local node (of minimum index with respect to global ordering) when changing the basis */
2288984c4197SStefano 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 */
2289785e854fSJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&aux_primal_minloc);CHKERRQ(ierr);
2290984c4197SStefano Zampini   /* auxiliary stuff for basis change */
2291785e854fSJed Brown   ierr = PetscMalloc1(max_size_of_constraint,&global_indices);CHKERRQ(ierr);
22924641a718SStefano Zampini   ierr = PetscBTCreate(pcis->n_B,&touched);CHKERRQ(ierr);
2293984c4197SStefano Zampini 
2294984c4197SStefano Zampini   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
2295984c4197SStefano Zampini   total_primal_vertices=0;
2296984c4197SStefano Zampini   for (i=0;i<pcbddc->local_primal_size;i++) {
2297674ae819SStefano Zampini     size_of_constraint=temp_indices[i+1]-temp_indices[i];
2298984c4197SStefano Zampini     if (size_of_constraint == 1) {
22994641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]]);CHKERRQ(ierr);
2300984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]];
2301984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=0;
2302984c4197SStefano Zampini       total_primal_vertices++;
23034641a718SStefano Zampini     } else if (PetscBTLookup(change_basis,i)) { /* Same procedure used in PCBDDCGetPrimalConstraintsLocalIdx */
2304984c4197SStefano Zampini       PetscInt min_loc,min_index;
2305984c4197SStefano Zampini       ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,&temp_indices_to_constraint[temp_indices[i]],global_indices);CHKERRQ(ierr);
2306984c4197SStefano Zampini       /* find first untouched local node */
2307674ae819SStefano Zampini       k = 0;
23084641a718SStefano Zampini       while (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) k++;
2309984c4197SStefano Zampini       min_index = global_indices[k];
2310984c4197SStefano Zampini       min_loc = k;
2311984c4197SStefano Zampini       /* search the minimum among global nodes already untouched on the cc */
2312984c4197SStefano Zampini       for (k=1;k<size_of_constraint;k++) {
2313984c4197SStefano Zampini         /* there can be more than one constraint on a single connected component */
23144641a718SStefano Zampini         if (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k]) && min_index > global_indices[k]) {
2315984c4197SStefano Zampini           min_index = global_indices[k];
2316984c4197SStefano Zampini           min_loc = k;
2317674ae819SStefano Zampini         }
2318674ae819SStefano Zampini       }
23194641a718SStefano Zampini       ierr = PetscBTSet(touched,temp_indices_to_constraint_B[temp_indices[i]+min_loc]);CHKERRQ(ierr);
2320984c4197SStefano Zampini       aux_primal_numbering[total_primal_vertices]=temp_indices_to_constraint[temp_indices[i]+min_loc];
2321984c4197SStefano Zampini       aux_primal_minloc[total_primal_vertices]=min_loc;
2322984c4197SStefano Zampini       total_primal_vertices++;
2323984c4197SStefano Zampini     }
2324984c4197SStefano Zampini   }
2325a717540cSStefano Zampini   /* determine if a QR strategy is needed for change of basis */
2326a717540cSStefano Zampini   qr_needed = PETSC_FALSE;
2327a717540cSStefano Zampini   ierr = PetscBTCreate(pcbddc->local_primal_size,&qr_needed_idx);CHKERRQ(ierr);
2328a717540cSStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
2329a717540cSStefano Zampini     if (PetscBTLookup(change_basis,i)) {
2330fa434743SStefano Zampini       if (!pcbddc->use_qr_single) {
2331a717540cSStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
2332a717540cSStefano Zampini         j = 0;
2333a717540cSStefano Zampini         for (k=0;k<size_of_constraint;k++) {
2334a717540cSStefano Zampini           if (PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+k])) {
2335a717540cSStefano Zampini             j++;
2336a717540cSStefano Zampini           }
2337a717540cSStefano Zampini         }
2338a717540cSStefano Zampini         /* found more than one primal dof on the cc */
2339a717540cSStefano Zampini         if (j > 1) {
2340a717540cSStefano Zampini           PetscBTSet(qr_needed_idx,i);
2341a717540cSStefano Zampini           qr_needed = PETSC_TRUE;
2342a717540cSStefano Zampini         }
2343fa434743SStefano Zampini       } else {
2344fa434743SStefano Zampini         PetscBTSet(qr_needed_idx,i);
2345fa434743SStefano Zampini         qr_needed = PETSC_TRUE;
2346fa434743SStefano Zampini       }
2347a717540cSStefano Zampini     }
2348a717540cSStefano Zampini   }
2349984c4197SStefano Zampini   /* free workspace */
2350984c4197SStefano Zampini   ierr = PetscFree(global_indices);CHKERRQ(ierr);
235145a1bb75SStefano Zampini 
2352674ae819SStefano Zampini   /* permute indices in order to have a sorted set of vertices */
2353a717540cSStefano Zampini   ierr = PetscSortInt(total_primal_vertices,aux_primal_numbering);CHKERRQ(ierr);
2354984c4197SStefano Zampini 
2355984c4197SStefano Zampini   /* nonzero structure of constraint matrix */
2356785e854fSJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
2357984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) nnz[i]=1;
2358984c4197SStefano Zampini   j=total_primal_vertices;
2359984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
23604641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
2361674ae819SStefano Zampini       nnz[j]=temp_indices[i+1]-temp_indices[i];
2362674ae819SStefano Zampini       j++;
2363674ae819SStefano Zampini     }
2364674ae819SStefano Zampini   }
2365674ae819SStefano Zampini   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
2366674ae819SStefano Zampini   ierr = PetscFree(nnz);CHKERRQ(ierr);
2367674ae819SStefano Zampini   /* set values in constraint matrix */
2368984c4197SStefano Zampini   for (i=0;i<total_primal_vertices;i++) {
2369984c4197SStefano Zampini     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,aux_primal_numbering[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
2370674ae819SStefano Zampini   }
2371984c4197SStefano Zampini   total_counts = total_primal_vertices;
2372984c4197SStefano Zampini   for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
23734641a718SStefano Zampini     if (!PetscBTLookup(change_basis,i)) {
2374674ae819SStefano Zampini       size_of_constraint=temp_indices[i+1]-temp_indices[i];
2375674ae819SStefano 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);
2376674ae819SStefano Zampini       total_counts++;
2377674ae819SStefano Zampini     }
2378674ae819SStefano Zampini   }
2379674ae819SStefano Zampini   /* assembling */
2380674ae819SStefano Zampini   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2381674ae819SStefano Zampini   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2382984c4197SStefano Zampini   /*
238345a1bb75SStefano Zampini   ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
2384984c4197SStefano Zampini   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
2385984c4197SStefano Zampini   */
2386674ae819SStefano Zampini   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
2387674ae819SStefano Zampini   if (pcbddc->use_change_of_basis) {
2388026de310SStefano Zampini     /* dual and primal dofs on a single cc */
2389984c4197SStefano Zampini     PetscInt     dual_dofs,primal_dofs;
2390026de310SStefano Zampini     /* iterator on aux_primal_minloc (ordered as read from nearnullspace: vertices, edges and then constraints) */
2391026de310SStefano Zampini     PetscInt     primal_counter;
2392984c4197SStefano Zampini     /* working stuff for GEQRF */
239381d9aea3SBarry Smith     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
2394984c4197SStefano Zampini     PetscBLASInt lqr_work;
2395984c4197SStefano Zampini     /* working stuff for UNGQR */
2396984c4197SStefano Zampini     PetscScalar  *gqr_work,lgqr_work_t;
2397984c4197SStefano Zampini     PetscBLASInt lgqr_work;
2398984c4197SStefano Zampini     /* working stuff for TRTRS */
2399984c4197SStefano Zampini     PetscScalar  *trs_rhs;
24003f08241aSStefano Zampini     PetscBLASInt Blas_NRHS;
2401984c4197SStefano Zampini     /* pointers for values insertion into change of basis matrix */
2402984c4197SStefano Zampini     PetscInt     *start_rows,*start_cols;
2403984c4197SStefano Zampini     PetscScalar  *start_vals;
2404984c4197SStefano Zampini     /* working stuff for values insertion */
24054641a718SStefano Zampini     PetscBT      is_primal;
2406906d46d4SStefano Zampini     /* matrix sizes */
2407906d46d4SStefano Zampini     PetscInt     global_size,local_size;
2408906d46d4SStefano Zampini     /* temporary change of basis */
2409906d46d4SStefano Zampini     Mat          localChangeOfBasisMatrix;
2410cf5a6209SStefano Zampini     /* extra space for debugging */
2411cf5a6209SStefano Zampini     PetscScalar  *dbg_work;
2412984c4197SStefano Zampini 
2413906d46d4SStefano Zampini     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
2414906d46d4SStefano Zampini     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
241516f15bc4SStefano Zampini     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
2416bbb9e6c6SStefano Zampini     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
2417906d46d4SStefano Zampini     /* nonzeros for local mat */
2418bbb9e6c6SStefano Zampini     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
2419bbb9e6c6SStefano Zampini     for (i=0;i<pcis->n;i++) nnz[i]=1;
2420a717540cSStefano Zampini     for (i=pcbddc->n_vertices;i<pcbddc->local_primal_size;i++) {
2421a717540cSStefano Zampini       if (PetscBTLookup(change_basis,i)) {
2422a717540cSStefano Zampini         size_of_constraint = temp_indices[i+1]-temp_indices[i];
2423a717540cSStefano Zampini         if (PetscBTLookup(qr_needed_idx,i)) {
2424bbb9e6c6SStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint[temp_indices[i]+j]] = size_of_constraint;
2425a717540cSStefano Zampini         } else {
2426bbb9e6c6SStefano Zampini           for (j=0;j<size_of_constraint;j++) nnz[temp_indices_to_constraint[temp_indices[i]+j]] = 2;
2427a717540cSStefano Zampini           /* get local primal index on the cc */
2428a717540cSStefano Zampini           j = 0;
2429a717540cSStefano Zampini           while (!PetscBTLookup(touched,temp_indices_to_constraint_B[temp_indices[i]+j])) j++;
2430bbb9e6c6SStefano Zampini           nnz[temp_indices_to_constraint[temp_indices[i]+j]] = size_of_constraint;
2431a717540cSStefano Zampini         }
2432a717540cSStefano Zampini       }
2433a717540cSStefano Zampini     }
2434906d46d4SStefano Zampini     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
2435bbb9e6c6SStefano Zampini     ierr = PetscFree(nnz);CHKERRQ(ierr);
2436a717540cSStefano Zampini     /* Set initial identity in the matrix */
2437bbb9e6c6SStefano Zampini     for (i=0;i<pcis->n;i++) {
2438906d46d4SStefano Zampini       ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
2439a717540cSStefano Zampini     }
2440a717540cSStefano Zampini 
2441a717540cSStefano Zampini     if (pcbddc->dbg_flag) {
2442a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
2443a717540cSStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
2444a717540cSStefano Zampini     }
2445a717540cSStefano Zampini 
2446a717540cSStefano Zampini 
2447a717540cSStefano Zampini     /* Now we loop on the constraints which need a change of basis */
2448a717540cSStefano Zampini     /*
2449a717540cSStefano Zampini        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
2450a717540cSStefano Zampini        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
2451a717540cSStefano Zampini 
2452a6b551f4SStefano Zampini        Basic blocks of change of basis matrix T computed by
2453a717540cSStefano Zampini 
2454a6b551f4SStefano 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)
2455a6b551f4SStefano Zampini 
2456a6b551f4SStefano Zampini             | 1        0   ...        0         s_1/S |
2457a6b551f4SStefano Zampini             | 0        1   ...        0         s_2/S |
2458a717540cSStefano Zampini             |              ...                        |
2459a6b551f4SStefano Zampini             | 0        ...            1     s_{n-1}/S |
2460a6b551f4SStefano Zampini             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
2461a717540cSStefano Zampini 
2462a6b551f4SStefano Zampini             with S = \sum_{i=1}^n s_i^2
2463a6b551f4SStefano Zampini             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
2464a6b551f4SStefano Zampini                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
2465a6b551f4SStefano Zampini 
2466a6b551f4SStefano Zampini           - QR decomposition of constraints otherwise
2467a717540cSStefano Zampini     */
2468a717540cSStefano Zampini     if (qr_needed) {
2469984c4197SStefano Zampini       /* space to store Q */
2470854ce69bSBarry Smith       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
2471984c4197SStefano Zampini       /* first we issue queries for optimal work */
24723f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
24733f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
24743f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2475984c4197SStefano Zampini       lqr_work = -1;
24763f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
2477984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
2478984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
2479785e854fSJed Brown       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
2480984c4197SStefano Zampini       lgqr_work = -1;
24813f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
24823f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
24833f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
24843f08241aSStefano Zampini       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
24853f08241aSStefano Zampini       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
24863f08241aSStefano Zampini       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
2487984c4197SStefano Zampini       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
2488984c4197SStefano Zampini       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
2489785e854fSJed Brown       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
2490984c4197SStefano Zampini       /* array to store scaling factors for reflectors */
2491785e854fSJed Brown       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
2492984c4197SStefano Zampini       /* array to store rhs and solution of triangular solver */
2493785e854fSJed Brown       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
2494a717540cSStefano Zampini       /* allocating workspace for check */
2495a717540cSStefano Zampini       if (pcbddc->dbg_flag) {
2496cf5a6209SStefano Zampini         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
2497a717540cSStefano Zampini       }
2498a717540cSStefano Zampini     }
2499984c4197SStefano Zampini     /* array to store whether a node is primal or not */
25004641a718SStefano Zampini     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
2501473ba861SJed Brown     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
25025e8657edSStefano Zampini     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,aux_primal_numbering,&i,aux_primal_numbering_B);CHKERRQ(ierr);
250339e2fb2aSStefano Zampini     if (i != total_primal_vertices) {
250439e2fb2aSStefano Zampini       SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Error in boundary numbering for BDDC vertices! %d != %d\n",total_primal_vertices,i);
25054641a718SStefano Zampini     }
250639e2fb2aSStefano Zampini     for (i=0;i<total_primal_vertices;i++) {
250739e2fb2aSStefano Zampini       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
250839e2fb2aSStefano Zampini     }
250939e2fb2aSStefano Zampini     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
2510984c4197SStefano Zampini 
2511a717540cSStefano Zampini     /* loop on constraints and see whether or not they need a change of basis and compute it */
2512026de310SStefano Zampini     /* -> using implicit ordering contained in temp_indices data */
2513026de310SStefano Zampini     total_counts = pcbddc->n_vertices;
2514026de310SStefano Zampini     primal_counter = total_counts;
2515026de310SStefano Zampini     while (total_counts<pcbddc->local_primal_size) {
2516026de310SStefano Zampini       primal_dofs = 1;
25174641a718SStefano Zampini       if (PetscBTLookup(change_basis,total_counts)) {
2518026de310SStefano Zampini         /* get all constraints with same support: if more then one constraint is present on the cc then surely indices are stored contiguosly */
2519bbb9e6c6SStefano 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]]) {
2520026de310SStefano Zampini           primal_dofs++;
2521674ae819SStefano Zampini         }
2522984c4197SStefano Zampini         /* get constraint info */
2523026de310SStefano Zampini         size_of_constraint = temp_indices[total_counts+1]-temp_indices[total_counts];
2524984c4197SStefano Zampini         dual_dofs = size_of_constraint-primal_dofs;
2525984c4197SStefano Zampini 
2526984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
2527a717540cSStefano 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);
2528674ae819SStefano Zampini         }
2529984c4197SStefano Zampini 
2530fa434743SStefano Zampini         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
2531a717540cSStefano Zampini 
2532a717540cSStefano Zampini           /* copy quadrature constraints for change of basis check */
2533a717540cSStefano Zampini           if (pcbddc->dbg_flag) {
2534cf5a6209SStefano Zampini             ierr = PetscMemcpy(dbg_work,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
2535a717540cSStefano Zampini           }
2536984c4197SStefano Zampini           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
2537026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
2538984c4197SStefano Zampini 
2539984c4197SStefano Zampini           /* compute QR decomposition of constraints */
25403f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
25413f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
25423f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2543674ae819SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
25443f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
2545984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
2546674ae819SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2547984c4197SStefano Zampini 
2548984c4197SStefano Zampini           /* explictly compute R^-T */
2549984c4197SStefano Zampini           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
2550984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
25513f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
25523f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
25533f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
25543f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
2555984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
25563f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
2557984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
2558984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2559984c4197SStefano Zampini 
2560a717540cSStefano Zampini           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
25613f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
25623f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
25633f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
25643f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2565984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
25663f08241aSStefano Zampini           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
2567984c4197SStefano Zampini           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
2568984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2569984c4197SStefano Zampini 
2570984c4197SStefano Zampini           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
2571984c4197SStefano Zampini              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
2572984c4197SStefano Zampini              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
25733f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
25743f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
25753f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
25763f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
25773f08241aSStefano Zampini           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
25783f08241aSStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
2579984c4197SStefano Zampini           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2580c4303822SStefano 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));
2581984c4197SStefano Zampini           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2582026de310SStefano Zampini           ierr = PetscMemcpy(qr_basis,&temp_quadrature_constraint[temp_indices[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
2583984c4197SStefano Zampini 
2584984c4197SStefano Zampini           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
2585bbb9e6c6SStefano Zampini           start_rows = &temp_indices_to_constraint[temp_indices[total_counts]];
2586984c4197SStefano Zampini           /* insert cols for primal dofs */
2587984c4197SStefano Zampini           for (j=0;j<primal_dofs;j++) {
2588984c4197SStefano Zampini             start_vals = &qr_basis[j*size_of_constraint];
2589bbb9e6c6SStefano Zampini             start_cols = &temp_indices_to_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter+j]];
2590906d46d4SStefano Zampini             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
2591984c4197SStefano Zampini           }
2592984c4197SStefano Zampini           /* insert cols for dual dofs */
2593984c4197SStefano Zampini           for (j=0,k=0;j<dual_dofs;k++) {
25944641a718SStefano Zampini             if (!PetscBTLookup(is_primal,temp_indices_to_constraint_B[temp_indices[total_counts]+k])) {
2595984c4197SStefano Zampini               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
2596bbb9e6c6SStefano Zampini               start_cols = &temp_indices_to_constraint[temp_indices[total_counts]+k];
2597906d46d4SStefano Zampini               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
2598984c4197SStefano Zampini               j++;
2599674ae819SStefano Zampini             }
2600674ae819SStefano Zampini           }
2601984c4197SStefano Zampini 
2602984c4197SStefano Zampini           /* check change of basis */
2603984c4197SStefano Zampini           if (pcbddc->dbg_flag) {
2604984c4197SStefano Zampini             PetscInt   ii,jj;
2605984c4197SStefano Zampini             PetscBool valid_qr=PETSC_TRUE;
2606c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
2607c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2608c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
2609c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
2610c4303822SStefano Zampini             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
2611c4303822SStefano Zampini             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
2612984c4197SStefano Zampini             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2613cf5a6209SStefano 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));
2614984c4197SStefano Zampini             ierr = PetscFPTrapPop();CHKERRQ(ierr);
2615984c4197SStefano Zampini             for (jj=0;jj<size_of_constraint;jj++) {
2616984c4197SStefano Zampini               for (ii=0;ii<primal_dofs;ii++) {
2617cf5a6209SStefano Zampini                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
2618cf5a6209SStefano 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;
2619674ae819SStefano Zampini               }
2620674ae819SStefano Zampini             }
2621984c4197SStefano Zampini             if (!valid_qr) {
262222d5777bSStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
2623984c4197SStefano Zampini               for (jj=0;jj<size_of_constraint;jj++) {
2624984c4197SStefano Zampini                 for (ii=0;ii<primal_dofs;ii++) {
2625cf5a6209SStefano Zampini                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
2626cf5a6209SStefano 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]));
2627674ae819SStefano Zampini                   }
2628cf5a6209SStefano Zampini                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
2629cf5a6209SStefano 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]));
2630984c4197SStefano Zampini                   }
2631984c4197SStefano Zampini                 }
2632984c4197SStefano Zampini               }
2633674ae819SStefano Zampini             } else {
263422d5777bSStefano Zampini               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
2635674ae819SStefano Zampini             }
2636674ae819SStefano Zampini           }
2637a717540cSStefano Zampini         } else { /* simple transformation block */
2638a717540cSStefano Zampini           PetscInt    row,col;
2639a6b551f4SStefano Zampini           PetscScalar val,norm;
2640a6b551f4SStefano Zampini 
2641a6b551f4SStefano Zampini           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
2642a6b551f4SStefano 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));
2643a717540cSStefano Zampini           for (j=0;j<size_of_constraint;j++) {
2644bbb9e6c6SStefano Zampini             PetscInt row_B = temp_indices_to_constraint_B[temp_indices[total_counts]+j];
2645bbb9e6c6SStefano Zampini             row = temp_indices_to_constraint[temp_indices[total_counts]+j];
2646bbb9e6c6SStefano Zampini             if (!PetscBTLookup(is_primal,row_B)) {
2647bbb9e6c6SStefano Zampini               col = temp_indices_to_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
2648906d46d4SStefano Zampini               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
2649a6b551f4SStefano Zampini               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,temp_quadrature_constraint[temp_indices[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
2650a717540cSStefano Zampini             } else {
2651a717540cSStefano Zampini               for (k=0;k<size_of_constraint;k++) {
2652bbb9e6c6SStefano Zampini                 col = temp_indices_to_constraint[temp_indices[total_counts]+k];
2653a717540cSStefano Zampini                 if (row != col) {
2654a717540cSStefano Zampini                   val = -temp_quadrature_constraint[temp_indices[total_counts]+k]/temp_quadrature_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter]];
2655a717540cSStefano Zampini                 } else {
2656a6b551f4SStefano Zampini                   val = temp_quadrature_constraint[temp_indices[total_counts]+aux_primal_minloc[primal_counter]]/norm;
2657a717540cSStefano Zampini                 }
2658906d46d4SStefano Zampini                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
2659a717540cSStefano Zampini               }
2660a717540cSStefano Zampini             }
2661a717540cSStefano Zampini           }
266298a51de6SStefano Zampini           if (pcbddc->dbg_flag) {
266322d5777bSStefano Zampini             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
2664a717540cSStefano Zampini           }
2665674ae819SStefano Zampini         }
2666026de310SStefano Zampini         /* increment primal counter */
2667026de310SStefano Zampini         primal_counter += primal_dofs;
2668984c4197SStefano Zampini       } else {
2669984c4197SStefano Zampini         if (pcbddc->dbg_flag) {
2670026de310SStefano 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);
2671674ae819SStefano Zampini         }
2672674ae819SStefano Zampini       }
2673026de310SStefano Zampini       /* increment constraint counter total_counts */
2674026de310SStefano Zampini       total_counts += primal_dofs;
2675674ae819SStefano Zampini     }
2676a717540cSStefano Zampini 
2677a717540cSStefano Zampini     /* free workspace */
2678a717540cSStefano Zampini     if (qr_needed) {
2679984c4197SStefano Zampini       if (pcbddc->dbg_flag) {
2680cf5a6209SStefano Zampini         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
2681984c4197SStefano Zampini       }
2682984c4197SStefano Zampini       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
2683984c4197SStefano Zampini       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
2684984c4197SStefano Zampini       ierr = PetscFree(qr_work);CHKERRQ(ierr);
2685984c4197SStefano Zampini       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
2686984c4197SStefano Zampini       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
2687674ae819SStefano Zampini     }
2688a717540cSStefano Zampini     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
2689906d46d4SStefano Zampini     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2690906d46d4SStefano Zampini     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2691906d46d4SStefano Zampini 
2692906d46d4SStefano Zampini     /* assembling of global change of variable */
2693bbb9e6c6SStefano Zampini     {
2694bbb9e6c6SStefano Zampini       Mat      tmat;
269516f15bc4SStefano Zampini       PetscInt bs;
269616f15bc4SStefano Zampini 
2697906d46d4SStefano Zampini       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
2698906d46d4SStefano Zampini       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
2699bbb9e6c6SStefano Zampini       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
2700bbb9e6c6SStefano Zampini       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
2701bbb9e6c6SStefano Zampini       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
2702bbb9e6c6SStefano Zampini       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
270316f15bc4SStefano Zampini       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
270416f15bc4SStefano Zampini       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
2705906d46d4SStefano Zampini       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
2706bbb9e6c6SStefano Zampini       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
2707bbb9e6c6SStefano Zampini       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
2708bbb9e6c6SStefano Zampini       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
2709bbb9e6c6SStefano Zampini       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
2710bbb9e6c6SStefano Zampini       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
2711bbb9e6c6SStefano Zampini       ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2712bbb9e6c6SStefano Zampini       ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2713bbb9e6c6SStefano Zampini       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
2714bbb9e6c6SStefano Zampini       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
2715906d46d4SStefano Zampini     }
2716906d46d4SStefano Zampini     /* check */
2717906d46d4SStefano Zampini     if (pcbddc->dbg_flag) {
2718906d46d4SStefano Zampini       PetscReal error;
2719906d46d4SStefano Zampini       Vec       x,x_change;
2720906d46d4SStefano Zampini 
2721906d46d4SStefano Zampini       ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
2722906d46d4SStefano Zampini       ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
2723906d46d4SStefano Zampini       ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
2724906d46d4SStefano Zampini       ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
2725bbb9e6c6SStefano Zampini       ierr = VecScatterBegin(matis->ctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2726bbb9e6c6SStefano Zampini       ierr = VecScatterEnd(matis->ctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
2727bbb9e6c6SStefano Zampini       ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
2728bbb9e6c6SStefano Zampini       ierr = VecScatterBegin(matis->ctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2729bbb9e6c6SStefano Zampini       ierr = VecScatterEnd(matis->ctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
2730906d46d4SStefano Zampini       ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
2731906d46d4SStefano Zampini       ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
2732906d46d4SStefano Zampini       ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
2733906d46d4SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2734bbb9e6c6SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Error global vs local change: %1.6e\n",error);CHKERRQ(ierr);
2735906d46d4SStefano Zampini       ierr = VecDestroy(&x);CHKERRQ(ierr);
2736906d46d4SStefano Zampini       ierr = VecDestroy(&x_change);CHKERRQ(ierr);
2737906d46d4SStefano Zampini     }
2738b96c3477SStefano Zampini 
2739b96c3477SStefano Zampini     /* adapt sub_schurs computed (if any) */
2740b96c3477SStefano Zampini     if (pcbddc->use_deluxe_scaling) {
2741b96c3477SStefano Zampini       PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
2742b96c3477SStefano Zampini       if (sub_schurs->n_subs_par_g) {
2743b7eb3628SStefano Zampini         SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Change of basis with deluxe scaling and parallel problems still needs to be implemented");
2744b96c3477SStefano Zampini       }
2745b96c3477SStefano Zampini       if (sub_schurs->S_Ej_all) {
2746b96c3477SStefano Zampini         Mat S_1,S_2,tmat;
2747bbb9e6c6SStefano Zampini         IS is_all_N;
2748bbb9e6c6SStefano Zampini 
2749bbb9e6c6SStefano Zampini         ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
2750d648f858SStefano Zampini         ierr = MatGetSubMatrixUnsorted(localChangeOfBasisMatrix,is_all_N,is_all_N,&tmat);CHKERRQ(ierr);
2751bbb9e6c6SStefano Zampini         ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
2752b96c3477SStefano Zampini         ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_1);CHKERRQ(ierr);
2753b96c3477SStefano Zampini         ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
2754b96c3477SStefano Zampini         sub_schurs->S_Ej_all = S_1;
2755b96c3477SStefano Zampini         ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_2);CHKERRQ(ierr);
2756b96c3477SStefano Zampini         ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
2757b96c3477SStefano Zampini         sub_schurs->sum_S_Ej_all = S_2;
2758b96c3477SStefano Zampini         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
2759b96c3477SStefano Zampini       }
2760b96c3477SStefano Zampini     }
2761906d46d4SStefano Zampini     ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
2762906d46d4SStefano Zampini   } else if (pcbddc->user_ChangeOfBasisMatrix) {
2763b9b85e73SStefano Zampini     ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
2764b9b85e73SStefano Zampini     pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
2765b9b85e73SStefano Zampini   }
2766906d46d4SStefano Zampini 
2767906d46d4SStefano Zampini   /* set up change of basis context */
2768906d46d4SStefano Zampini   if (pcbddc->ChangeOfBasisMatrix) {
2769906d46d4SStefano Zampini     PCBDDCChange_ctx change_ctx;
2770906d46d4SStefano Zampini 
2771906d46d4SStefano Zampini     if (!pcbddc->new_global_mat) {
2772906d46d4SStefano Zampini       PetscInt global_size,local_size;
2773906d46d4SStefano Zampini 
2774906d46d4SStefano Zampini       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
2775906d46d4SStefano Zampini       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
2776906d46d4SStefano Zampini       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->new_global_mat);CHKERRQ(ierr);
2777906d46d4SStefano Zampini       ierr = MatSetSizes(pcbddc->new_global_mat,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
2778906d46d4SStefano Zampini       ierr = MatSetType(pcbddc->new_global_mat,MATSHELL);CHKERRQ(ierr);
2779906d46d4SStefano Zampini       ierr = MatShellSetOperation(pcbddc->new_global_mat,MATOP_MULT,(void (*)(void))PCBDDCMatMult_Private);CHKERRQ(ierr);
2780906d46d4SStefano Zampini       ierr = MatShellSetOperation(pcbddc->new_global_mat,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCMatMultTranspose_Private);CHKERRQ(ierr);
2781906d46d4SStefano Zampini       ierr = PetscNew(&change_ctx);CHKERRQ(ierr);
2782906d46d4SStefano Zampini       ierr = MatShellSetContext(pcbddc->new_global_mat,change_ctx);CHKERRQ(ierr);
2783906d46d4SStefano Zampini     } else {
2784906d46d4SStefano Zampini       ierr = MatShellGetContext(pcbddc->new_global_mat,&change_ctx);CHKERRQ(ierr);
2785906d46d4SStefano Zampini       ierr = MatDestroy(&change_ctx->global_change);CHKERRQ(ierr);
2786906d46d4SStefano Zampini       ierr = VecDestroyVecs(2,&change_ctx->work);CHKERRQ(ierr);
2787906d46d4SStefano Zampini     }
2788906d46d4SStefano Zampini     if (!pcbddc->user_ChangeOfBasisMatrix) {
2789906d46d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
2790906d46d4SStefano Zampini       change_ctx->global_change = pcbddc->ChangeOfBasisMatrix;
2791906d46d4SStefano Zampini     } else {
2792906d46d4SStefano Zampini       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
2793906d46d4SStefano Zampini       change_ctx->global_change = pcbddc->user_ChangeOfBasisMatrix;
2794906d46d4SStefano Zampini     }
2795906d46d4SStefano Zampini     ierr = VecDuplicateVecs(pcis->vec1_global,2,&change_ctx->work);CHKERRQ(ierr);
2796906d46d4SStefano Zampini     ierr = MatSetUp(pcbddc->new_global_mat);CHKERRQ(ierr);
2797906d46d4SStefano Zampini     ierr = MatAssemblyBegin(pcbddc->new_global_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2798906d46d4SStefano Zampini     ierr = MatAssemblyEnd(pcbddc->new_global_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2799b9b85e73SStefano Zampini   }
2800a717540cSStefano Zampini 
2801727cdba6SStefano Zampini   /* get indices in local ordering for vertices and constraints */
2802727cdba6SStefano 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 */
2803473ba861SJed Brown     ierr = PetscMalloc1(olocal_primal_size,&oprimal_indices_local_idxs);CHKERRQ(ierr);
2804727cdba6SStefano Zampini     ierr = PetscMemcpy(oprimal_indices_local_idxs,pcbddc->primal_indices_local_idxs,olocal_primal_size*sizeof(PetscInt));CHKERRQ(ierr);
2805727cdba6SStefano Zampini   }
2806727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2807f347579bSStefano Zampini   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
2808473ba861SJed Brown   ierr = PetscMalloc1(pcbddc->local_primal_size,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
2809727cdba6SStefano Zampini   ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&aux_primal_numbering);CHKERRQ(ierr);
2810727cdba6SStefano Zampini   ierr = PetscMemcpy(pcbddc->primal_indices_local_idxs,aux_primal_numbering,i*sizeof(PetscInt));CHKERRQ(ierr);
2811727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2812727cdba6SStefano Zampini   ierr = PCBDDCGetPrimalConstraintsLocalIdx(pc,&j,&aux_primal_numbering);CHKERRQ(ierr);
2813727cdba6SStefano Zampini   ierr = PetscMemcpy(&pcbddc->primal_indices_local_idxs[i],aux_primal_numbering,j*sizeof(PetscInt));CHKERRQ(ierr);
2814727cdba6SStefano Zampini   ierr = PetscFree(aux_primal_numbering);CHKERRQ(ierr);
2815e9189074SStefano Zampini   /* set quantities in PCBDDC data struct */
2816e9189074SStefano Zampini   pcbddc->n_actual_vertices = i;
2817727cdba6SStefano Zampini   /* check if a new primal space has been introduced */
2818727cdba6SStefano Zampini   pcbddc->new_primal_space_local = PETSC_TRUE;
2819727cdba6SStefano Zampini   if (olocal_primal_size == pcbddc->local_primal_size) {
2820727cdba6SStefano Zampini     ierr = PetscMemcmp(pcbddc->primal_indices_local_idxs,oprimal_indices_local_idxs,olocal_primal_size,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
2821c1c8e736SStefano Zampini     pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
2822727cdba6SStefano Zampini     ierr = PetscFree(oprimal_indices_local_idxs);CHKERRQ(ierr);
2823727cdba6SStefano Zampini   }
2824727cdba6SStefano Zampini   /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
2825727cdba6SStefano Zampini   ierr = MPI_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2826727cdba6SStefano Zampini 
2827a717540cSStefano Zampini   /* flush dbg viewer */
2828b8ffe317SStefano Zampini   if (pcbddc->dbg_flag) {
2829b8ffe317SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2830b8ffe317SStefano Zampini   }
2831a717540cSStefano Zampini 
2832e310c8b4SStefano Zampini   /* free workspace */
2833a717540cSStefano Zampini   ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
2834a717540cSStefano Zampini   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
2835984c4197SStefano Zampini   ierr = PetscFree(aux_primal_minloc);CHKERRQ(ierr);
28364641a718SStefano Zampini   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
283708122e43SStefano Zampini   if (!pcbddc->adaptive_selection) {
2838906d46d4SStefano Zampini     ierr = PetscFree(temp_indices);CHKERRQ(ierr);
2839906d46d4SStefano Zampini     ierr = PetscFree3(temp_quadrature_constraint,temp_indices_to_constraint,temp_indices_to_constraint_B);CHKERRQ(ierr);
284008122e43SStefano Zampini   } else {
284108122e43SStefano Zampini     ierr = PetscFree4(pcbddc->adaptive_constraints_n,
284208122e43SStefano Zampini                       pcbddc->adaptive_constraints_ptrs,
284308122e43SStefano Zampini                       pcbddc->adaptive_constraints_idxs,
284408122e43SStefano Zampini                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
284508122e43SStefano Zampini     ierr = PetscFree(temp_indices_to_constraint_B);CHKERRQ(ierr);
284608122e43SStefano Zampini   }
2847674ae819SStefano Zampini   PetscFunctionReturn(0);
2848674ae819SStefano Zampini }
2849674ae819SStefano Zampini 
2850674ae819SStefano Zampini #undef __FUNCT__
2851674ae819SStefano Zampini #define __FUNCT__ "PCBDDCAnalyzeInterface"
2852674ae819SStefano Zampini PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
2853674ae819SStefano Zampini {
2854674ae819SStefano Zampini   PC_BDDC     *pcbddc = (PC_BDDC*)pc->data;
2855674ae819SStefano Zampini   PC_IS       *pcis = (PC_IS*)pc->data;
2856674ae819SStefano Zampini   Mat_IS      *matis  = (Mat_IS*)pc->pmat->data;
285763602bcaSStefano Zampini   PetscInt    ierr,i,vertex_size;
2858674ae819SStefano Zampini   PetscViewer viewer=pcbddc->dbg_viewer;
2859674ae819SStefano Zampini 
2860674ae819SStefano Zampini   PetscFunctionBegin;
28618e61c736SStefano Zampini   /* Reset previously computed graph */
28628e61c736SStefano Zampini   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
2863674ae819SStefano Zampini   /* Init local Graph struct */
2864674ae819SStefano Zampini   ierr = PCBDDCGraphInit(pcbddc->mat_graph,matis->mapping);CHKERRQ(ierr);
2865674ae819SStefano Zampini 
2866575ad6abSStefano Zampini   /* Check validity of the csr graph passed in by the user */
2867575ad6abSStefano Zampini   if (pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) {
2868575ad6abSStefano Zampini     ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
2869575ad6abSStefano Zampini   }
28709577ea80SStefano Zampini 
2871674ae819SStefano Zampini   /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
28724d379d7bSStefano Zampini   if (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) {
28734d379d7bSStefano Zampini     PetscInt  *xadj,*adjncy;
28744d379d7bSStefano Zampini     PetscInt  nvtxs;
2875*e496cd5dSStefano Zampini     PetscBool flg_row=PETSC_FALSE;
2876674ae819SStefano Zampini 
28774d379d7bSStefano Zampini     if (pcbddc->use_local_adj) {
28782fffb893SStefano Zampini 
28792fffb893SStefano Zampini       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
28802fffb893SStefano Zampini       if (flg_row) {
28814d379d7bSStefano Zampini         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
2882b96c3477SStefano Zampini         pcbddc->computed_rowadj = PETSC_TRUE;
28832fffb893SStefano Zampini       }
28842fffb893SStefano Zampini       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
28852fffb893SStefano Zampini     } else if (pcbddc->current_level) { /* just compute subdomain's connected components for coarser levels */
28864d379d7bSStefano Zampini       IS                     is_dummy;
28874d379d7bSStefano Zampini       ISLocalToGlobalMapping l2gmap_dummy;
28884d379d7bSStefano Zampini       PetscInt               j,sum;
28894d379d7bSStefano Zampini       PetscInt               *cxadj,*cadjncy;
28904d379d7bSStefano Zampini       const PetscInt         *idxs;
28914d379d7bSStefano Zampini       PCBDDCGraph            graph;
28924d379d7bSStefano Zampini       PetscBT                is_on_boundary;
28934d379d7bSStefano Zampini 
28944d379d7bSStefano Zampini       ierr = ISCreateStride(PETSC_COMM_SELF,pcis->n,0,1,&is_dummy);CHKERRQ(ierr);
28954d379d7bSStefano Zampini       ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
28964d379d7bSStefano Zampini       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
28974d379d7bSStefano Zampini       ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
28984d379d7bSStefano Zampini       ierr = PCBDDCGraphInit(graph,l2gmap_dummy);CHKERRQ(ierr);
28994d379d7bSStefano Zampini       ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2900*e496cd5dSStefano Zampini       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2901*e496cd5dSStefano Zampini       if (flg_row) {
29024d379d7bSStefano Zampini         graph->xadj = xadj;
29034d379d7bSStefano Zampini         graph->adjncy = adjncy;
2904*e496cd5dSStefano Zampini       }
29054d379d7bSStefano Zampini       ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
29064d379d7bSStefano Zampini       ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2907*e496cd5dSStefano Zampini       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
29084d379d7bSStefano Zampini 
29094d379d7bSStefano Zampini       if (pcbddc->dbg_flag) {
29104d379d7bSStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"[%d] Found %d subdomains\n",PetscGlobalRank,graph->ncc);CHKERRQ(ierr);
29114d379d7bSStefano Zampini         for (i=0;i<graph->ncc;i++) {
29124d379d7bSStefano Zampini           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"[%d] %d cc size %d\n",PetscGlobalRank,i,graph->cptr[i+1]-graph->cptr[i]);CHKERRQ(ierr);
29134d379d7bSStefano Zampini         }
29144d379d7bSStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
29154d379d7bSStefano Zampini       }
29164d379d7bSStefano Zampini 
2917*e496cd5dSStefano Zampini       ierr = PetscBTCreate(pcis->n,&is_on_boundary);CHKERRQ(ierr);
29184d379d7bSStefano Zampini       ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
29194d379d7bSStefano Zampini       for (i=0;i<pcis->n_B;i++) {
29204d379d7bSStefano Zampini         ierr = PetscBTSet(is_on_boundary,idxs[i]);CHKERRQ(ierr);
29214d379d7bSStefano Zampini       }
29224d379d7bSStefano Zampini       ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
29234d379d7bSStefano Zampini 
2924*e496cd5dSStefano Zampini       ierr = PetscCalloc1(pcis->n+1,&cxadj);CHKERRQ(ierr);
29254d379d7bSStefano Zampini       sum = 0;
29264d379d7bSStefano Zampini       for (i=0;i<graph->ncc;i++) {
29274d379d7bSStefano Zampini         PetscInt sizecc = 0;
29284d379d7bSStefano Zampini         for (j=graph->cptr[i];j<graph->cptr[i+1];j++) {
29294d379d7bSStefano Zampini           if (PetscBTLookup(is_on_boundary,graph->queue[j])) {
29304d379d7bSStefano Zampini             sizecc++;
29314d379d7bSStefano Zampini           }
29324d379d7bSStefano Zampini         }
29334d379d7bSStefano Zampini         for (j=graph->cptr[i];j<graph->cptr[i+1];j++) {
29344d379d7bSStefano Zampini           if (PetscBTLookup(is_on_boundary,graph->queue[j])) {
29354d379d7bSStefano Zampini             cxadj[graph->queue[j]] = sizecc;
29364d379d7bSStefano Zampini           }
29374d379d7bSStefano Zampini         }
29384d379d7bSStefano Zampini         sum += sizecc*sizecc;
29394d379d7bSStefano Zampini       }
29404d379d7bSStefano Zampini       ierr = PetscMalloc1(sum,&cadjncy);CHKERRQ(ierr);
29414d379d7bSStefano Zampini       sum = 0;
2942*e496cd5dSStefano Zampini       for (i=0;i<pcis->n;i++) {
29434d379d7bSStefano Zampini         PetscInt temp = cxadj[i];
29444d379d7bSStefano Zampini         cxadj[i] = sum;
29454d379d7bSStefano Zampini         sum += temp;
29464d379d7bSStefano Zampini       }
2947*e496cd5dSStefano Zampini       cxadj[pcis->n] = sum;
29484d379d7bSStefano Zampini       for (i=0;i<graph->ncc;i++) {
29494d379d7bSStefano Zampini         for (j=graph->cptr[i];j<graph->cptr[i+1];j++) {
29504d379d7bSStefano Zampini           if (PetscBTLookup(is_on_boundary,graph->queue[j])) {
29514d379d7bSStefano Zampini             PetscInt k,sizecc = 0;
29524d379d7bSStefano Zampini             for (k=graph->cptr[i];k<graph->cptr[i+1];k++) {
29534d379d7bSStefano Zampini               if (PetscBTLookup(is_on_boundary,graph->queue[k])) {
29544d379d7bSStefano Zampini                 cadjncy[cxadj[graph->queue[j]]+sizecc]=graph->queue[k];
29554d379d7bSStefano Zampini                 sizecc++;
29564d379d7bSStefano Zampini               }
29574d379d7bSStefano Zampini             }
29584d379d7bSStefano Zampini           }
29594d379d7bSStefano Zampini         }
29604d379d7bSStefano Zampini       }
2961*e496cd5dSStefano Zampini       if (pcis->n) {
2962*e496cd5dSStefano Zampini         ierr = PCBDDCSetLocalAdjacencyGraph(pc,pcis->n,cxadj,cadjncy,PETSC_OWN_POINTER);CHKERRQ(ierr);
29634d379d7bSStefano Zampini       } else {
29644d379d7bSStefano Zampini         ierr = PetscFree(cxadj);CHKERRQ(ierr);
29654d379d7bSStefano Zampini         ierr = PetscFree(cadjncy);CHKERRQ(ierr);
29664d379d7bSStefano Zampini       }
29674d379d7bSStefano Zampini       graph->xadj = 0;
29684d379d7bSStefano Zampini       graph->adjncy = 0;
29694d379d7bSStefano Zampini       ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
29704d379d7bSStefano Zampini       ierr = PetscBTDestroy(&is_on_boundary);CHKERRQ(ierr);
29714d379d7bSStefano Zampini     }
2972674ae819SStefano Zampini   }
2973674ae819SStefano Zampini 
297463602bcaSStefano Zampini   /* Set default dofs' splitting if no information has been provided by the user with PCBDDCSetDofsSplitting or PCBDDCSetDofsSplittingLocal */
2975674ae819SStefano Zampini   vertex_size = 1;
297663602bcaSStefano Zampini   if (pcbddc->user_provided_isfordofs) {
297763602bcaSStefano Zampini     if (pcbddc->n_ISForDofs) { /* need to convert from global to local and remove references to global dofs splitting */
297895ecbf38SStefano Zampini       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
297963602bcaSStefano Zampini       for (i=0;i<pcbddc->n_ISForDofs;i++) {
2980a7dc3881SStefano Zampini         ierr = PCBDDCGlobalToLocal(matis->ctx,pcis->vec1_global,pcis->vec1_N,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
298163602bcaSStefano Zampini         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
2982674ae819SStefano Zampini       }
298363602bcaSStefano Zampini       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
298463602bcaSStefano Zampini       pcbddc->n_ISForDofs = 0;
298563602bcaSStefano Zampini       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
2986674ae819SStefano Zampini     }
298763602bcaSStefano Zampini     /* mat block size as vertex size (used for elasticity with rigid body modes as nearnullspace) */
2988674ae819SStefano Zampini     ierr = MatGetBlockSize(matis->A,&vertex_size);CHKERRQ(ierr);
298963602bcaSStefano Zampini   } else {
299063602bcaSStefano Zampini     if (!pcbddc->n_ISForDofsLocal) { /* field split not present, create it in local ordering */
299163602bcaSStefano Zampini       ierr = MatGetBlockSize(pc->pmat,&pcbddc->n_ISForDofsLocal);CHKERRQ(ierr);
2992854ce69bSBarry Smith       ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
299363602bcaSStefano Zampini       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
299463602bcaSStefano Zampini         ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),pcis->n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
299563602bcaSStefano Zampini       }
299663602bcaSStefano Zampini     }
2997674ae819SStefano Zampini   }
2998674ae819SStefano Zampini 
2999674ae819SStefano Zampini   /* Setup of Graph */
3000785d1243SStefano Zampini   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) { /* need to convert from global to local */
3001a7dc3881SStefano Zampini     ierr = PCBDDCGlobalToLocal(matis->ctx,pcis->vec1_global,pcis->vec1_N,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3002785d1243SStefano Zampini   }
3003785d1243SStefano Zampini   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) { /* need to convert from global to local */
3004a7dc3881SStefano Zampini     ierr = PCBDDCGlobalToLocal(matis->ctx,pcis->vec1_global,pcis->vec1_N,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3005785d1243SStefano Zampini   }
300663602bcaSStefano Zampini   ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices);
3007674ae819SStefano Zampini 
3008674ae819SStefano Zampini   /* Graph's connected components analysis */
3009674ae819SStefano Zampini   ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
3010674ae819SStefano Zampini 
3011674ae819SStefano Zampini   /* print some info to stdout */
3012674ae819SStefano Zampini   if (pcbddc->dbg_flag) {
3013e49050b4SStefano Zampini     ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,viewer);
3014674ae819SStefano Zampini   }
3015fb180af4SStefano Zampini 
3016fb180af4SStefano Zampini   /* mark topography has done */
3017fb180af4SStefano Zampini   pcbddc->recompute_topography = PETSC_FALSE;
3018674ae819SStefano Zampini   PetscFunctionReturn(0);
3019674ae819SStefano Zampini }
3020674ae819SStefano Zampini 
3021674ae819SStefano Zampini #undef __FUNCT__
3022674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalVerticesLocalIdx"
3023f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalVerticesLocalIdx(PC pc, PetscInt *n_vertices, PetscInt **vertices_idx)
3024674ae819SStefano Zampini {
3025674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
3026674ae819SStefano Zampini   PetscInt       *vertices,*row_cmat_indices,n,i,size_of_constraint,local_primal_size;
3027674ae819SStefano Zampini   PetscErrorCode ierr;
3028674ae819SStefano Zampini 
3029674ae819SStefano Zampini   PetscFunctionBegin;
3030674ae819SStefano Zampini   n = 0;
3031674ae819SStefano Zampini   vertices = 0;
3032674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
3033674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&i);CHKERRQ(ierr);
3034b120a5c6SStefano Zampini     for (i=0;i<local_primal_size;i++) {
3035b120a5c6SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
3036b120a5c6SStefano Zampini       if (size_of_constraint == 1) n++;
3037b120a5c6SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
3038b120a5c6SStefano Zampini     }
3039811e8ca2SStefano Zampini     if (vertices_idx) {
3040785e854fSJed Brown       ierr = PetscMalloc1(n,&vertices);CHKERRQ(ierr);
3041b120a5c6SStefano Zampini       n = 0;
3042674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
3043674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
3044674ae819SStefano Zampini         if (size_of_constraint == 1) {
3045674ae819SStefano Zampini           vertices[n++]=row_cmat_indices[0];
3046674ae819SStefano Zampini         }
3047674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
3048674ae819SStefano Zampini       }
3049674ae819SStefano Zampini     }
3050811e8ca2SStefano Zampini   }
3051674ae819SStefano Zampini   *n_vertices = n;
3052811e8ca2SStefano Zampini   if (vertices_idx) *vertices_idx = vertices;
3053674ae819SStefano Zampini   PetscFunctionReturn(0);
3054674ae819SStefano Zampini }
3055674ae819SStefano Zampini 
3056674ae819SStefano Zampini #undef __FUNCT__
3057674ae819SStefano Zampini #define __FUNCT__ "PCBDDCGetPrimalConstraintsLocalIdx"
3058f34684f1SStefano Zampini PetscErrorCode  PCBDDCGetPrimalConstraintsLocalIdx(PC pc, PetscInt *n_constraints, PetscInt **constraints_idx)
3059674ae819SStefano Zampini {
3060674ae819SStefano Zampini   PC_BDDC        *pcbddc = (PC_BDDC*)(pc->data);
3061674ae819SStefano Zampini   PetscInt       *constraints_index,*row_cmat_indices,*row_cmat_global_indices;
3062674ae819SStefano Zampini   PetscInt       n,i,j,size_of_constraint,local_primal_size,local_size,max_size_of_constraint,min_index,min_loc;
30634641a718SStefano Zampini   PetscBT        touched;
3064674ae819SStefano Zampini   PetscErrorCode ierr;
3065674ae819SStefano Zampini 
3066f34684f1SStefano Zampini     /* This function assumes that the number of local constraints per connected component
3067f34684f1SStefano Zampini        is not greater than the number of nodes defined for the connected component
3068f34684f1SStefano Zampini        (otherwise we will surely have linear dependence between constraints and thus a singular coarse problem) */
3069674ae819SStefano Zampini   PetscFunctionBegin;
3070674ae819SStefano Zampini   n = 0;
3071674ae819SStefano Zampini   constraints_index = 0;
3072674ae819SStefano Zampini   if (pcbddc->ConstraintMatrix) {
3073674ae819SStefano Zampini     ierr = MatGetSize(pcbddc->ConstraintMatrix,&local_primal_size,&local_size);CHKERRQ(ierr);
3074674ae819SStefano Zampini     max_size_of_constraint = 0;
3075674ae819SStefano Zampini     for (i=0;i<local_primal_size;i++) {
3076674ae819SStefano Zampini       ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
3077674ae819SStefano Zampini       if (size_of_constraint > 1) {
3078674ae819SStefano Zampini         n++;
3079674ae819SStefano Zampini       }
3080674ae819SStefano Zampini       max_size_of_constraint = PetscMax(size_of_constraint,max_size_of_constraint);
3081674ae819SStefano Zampini       ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,NULL,NULL);CHKERRQ(ierr);
3082674ae819SStefano Zampini     }
3083811e8ca2SStefano Zampini     if (constraints_idx) {
3084785e854fSJed Brown       ierr = PetscMalloc1(n,&constraints_index);CHKERRQ(ierr);
3085785e854fSJed Brown       ierr = PetscMalloc1(max_size_of_constraint,&row_cmat_global_indices);CHKERRQ(ierr);
30864641a718SStefano Zampini       ierr = PetscBTCreate(local_size,&touched);CHKERRQ(ierr);
3087674ae819SStefano Zampini       n = 0;
3088674ae819SStefano Zampini       for (i=0;i<local_primal_size;i++) {
3089674ae819SStefano Zampini         ierr = MatGetRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
3090674ae819SStefano Zampini         if (size_of_constraint > 1) {
3091674ae819SStefano Zampini           ierr = ISLocalToGlobalMappingApply(pcbddc->mat_graph->l2gmap,size_of_constraint,row_cmat_indices,row_cmat_global_indices);CHKERRQ(ierr);
309282d3d8afSStefano Zampini           /* find first untouched local node */
309382d3d8afSStefano Zampini           j = 0;
30944641a718SStefano Zampini           while (PetscBTLookup(touched,row_cmat_indices[j])) j++;
309582d3d8afSStefano Zampini           min_index = row_cmat_global_indices[j];
309682d3d8afSStefano Zampini           min_loc = j;
309782d3d8afSStefano Zampini           /* search the minimum among nodes not yet touched on the connected component
309882d3d8afSStefano Zampini              since there can be more than one constraint on a single cc */
3099674ae819SStefano Zampini           for (j=1;j<size_of_constraint;j++) {
31004641a718SStefano Zampini             if (!PetscBTLookup(touched,row_cmat_indices[j]) && min_index > row_cmat_global_indices[j]) {
3101674ae819SStefano Zampini               min_index = row_cmat_global_indices[j];
3102674ae819SStefano Zampini               min_loc = j;
3103674ae819SStefano Zampini             }
3104674ae819SStefano Zampini           }
31054641a718SStefano Zampini           ierr = PetscBTSet(touched,row_cmat_indices[min_loc]);CHKERRQ(ierr);
3106674ae819SStefano Zampini           constraints_index[n++] = row_cmat_indices[min_loc];
3107674ae819SStefano Zampini         }
3108674ae819SStefano Zampini         ierr = MatRestoreRow(pcbddc->ConstraintMatrix,i,&size_of_constraint,(const PetscInt**)&row_cmat_indices,NULL);CHKERRQ(ierr);
3109674ae819SStefano Zampini       }
31104641a718SStefano Zampini       ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
3111674ae819SStefano Zampini       ierr = PetscFree(row_cmat_global_indices);CHKERRQ(ierr);
3112811e8ca2SStefano Zampini     }
3113811e8ca2SStefano Zampini   }
3114674ae819SStefano Zampini   *n_constraints = n;
3115811e8ca2SStefano Zampini   if (constraints_idx) *constraints_idx = constraints_index;
3116674ae819SStefano Zampini   PetscFunctionReturn(0);
3117674ae819SStefano Zampini }
3118674ae819SStefano Zampini 
3119674ae819SStefano Zampini #undef __FUNCT__
3120674ae819SStefano Zampini #define __FUNCT__ "PCBDDCSubsetNumbering"
3121674ae819SStefano 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[])
3122674ae819SStefano Zampini {
3123674ae819SStefano Zampini   Vec            local_vec,global_vec;
3124674ae819SStefano Zampini   IS             seqis,paris;
3125674ae819SStefano Zampini   VecScatter     scatter_ctx;
3126674ae819SStefano Zampini   PetscScalar    *array;
3127674ae819SStefano Zampini   PetscInt       *temp_global_dofs;
3128674ae819SStefano Zampini   PetscScalar    globalsum;
3129674ae819SStefano Zampini   PetscInt       i,j,s;
3130674ae819SStefano Zampini   PetscInt       nlocals,first_index,old_index,max_local;
3131674ae819SStefano Zampini   PetscMPIInt    rank_prec_comm,size_prec_comm,max_global;
3132674ae819SStefano Zampini   PetscMPIInt    *dof_sizes,*dof_displs;
3133674ae819SStefano Zampini   PetscBool      first_found;
3134674ae819SStefano Zampini   PetscErrorCode ierr;
3135674ae819SStefano Zampini 
3136674ae819SStefano Zampini   PetscFunctionBegin;
3137674ae819SStefano Zampini   /* mpi buffers */
3138b9b85e73SStefano Zampini   ierr = MPI_Comm_size(comm,&size_prec_comm);CHKERRQ(ierr);
3139b9b85e73SStefano Zampini   ierr = MPI_Comm_rank(comm,&rank_prec_comm);CHKERRQ(ierr);
3140674ae819SStefano Zampini   j = ( !rank_prec_comm ? size_prec_comm : 0);
3141785e854fSJed Brown   ierr = PetscMalloc1(j,&dof_sizes);CHKERRQ(ierr);
3142785e854fSJed Brown   ierr = PetscMalloc1(j,&dof_displs);CHKERRQ(ierr);
3143674ae819SStefano Zampini   /* get maximum size of subset */
3144785e854fSJed Brown   ierr = PetscMalloc1(n_local_dofs,&temp_global_dofs);CHKERRQ(ierr);
3145674ae819SStefano Zampini   ierr = ISLocalToGlobalMappingApply(l2gmap,n_local_dofs,local_dofs,temp_global_dofs);CHKERRQ(ierr);
3146674ae819SStefano Zampini   max_local = 0;
3147b9b85e73SStefano Zampini   for (i=0;i<n_local_dofs;i++) {
3148674ae819SStefano Zampini     if (max_local < temp_global_dofs[i] ) {
3149674ae819SStefano Zampini       max_local = temp_global_dofs[i];
3150674ae819SStefano Zampini     }
3151674ae819SStefano Zampini   }
3152b9b85e73SStefano Zampini   ierr = MPI_Allreduce(&max_local,&max_global,1,MPIU_INT,MPI_MAX,comm);CHKERRQ(ierr);
3153674ae819SStefano Zampini   max_global++;
3154674ae819SStefano Zampini   max_local = 0;
3155b9b85e73SStefano Zampini   for (i=0;i<n_local_dofs;i++) {
3156674ae819SStefano Zampini     if (max_local < local_dofs[i] ) {
3157674ae819SStefano Zampini       max_local = local_dofs[i];
3158674ae819SStefano Zampini     }
3159674ae819SStefano Zampini   }
3160674ae819SStefano Zampini   max_local++;
3161674ae819SStefano Zampini   /* allocate workspace */
3162674ae819SStefano Zampini   ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
3163674ae819SStefano Zampini   ierr = VecSetSizes(local_vec,PETSC_DECIDE,max_local);CHKERRQ(ierr);
3164674ae819SStefano Zampini   ierr = VecSetType(local_vec,VECSEQ);CHKERRQ(ierr);
3165674ae819SStefano Zampini   ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
3166674ae819SStefano Zampini   ierr = VecSetSizes(global_vec,PETSC_DECIDE,max_global);CHKERRQ(ierr);
3167674ae819SStefano Zampini   ierr = VecSetType(global_vec,VECMPI);CHKERRQ(ierr);
3168674ae819SStefano Zampini   /* create scatter */
3169674ae819SStefano Zampini   ierr = ISCreateGeneral(PETSC_COMM_SELF,n_local_dofs,local_dofs,PETSC_COPY_VALUES,&seqis);CHKERRQ(ierr);
3170674ae819SStefano Zampini   ierr = ISCreateGeneral(comm,n_local_dofs,temp_global_dofs,PETSC_COPY_VALUES,&paris);CHKERRQ(ierr);
3171674ae819SStefano Zampini   ierr = VecScatterCreate(local_vec,seqis,global_vec,paris,&scatter_ctx);CHKERRQ(ierr);
3172674ae819SStefano Zampini   ierr = ISDestroy(&seqis);CHKERRQ(ierr);
3173674ae819SStefano Zampini   ierr = ISDestroy(&paris);CHKERRQ(ierr);
3174674ae819SStefano Zampini   /* init array */
3175674ae819SStefano Zampini   ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
3176674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
3177674ae819SStefano Zampini   ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
3178674ae819SStefano Zampini   if (local_dofs_mult) {
3179674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
3180674ae819SStefano Zampini       array[local_dofs[i]]=(PetscScalar)local_dofs_mult[i];
3181674ae819SStefano Zampini     }
3182674ae819SStefano Zampini   } else {
3183674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
3184674ae819SStefano Zampini       array[local_dofs[i]]=1.0;
3185674ae819SStefano Zampini     }
3186674ae819SStefano Zampini   }
3187674ae819SStefano Zampini   ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
3188674ae819SStefano Zampini   /* scatter into global vec and get total number of global dofs */
3189674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3190674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3191674ae819SStefano Zampini   ierr = VecSum(global_vec,&globalsum);CHKERRQ(ierr);
31925b08dc53SStefano Zampini   *n_global_subset = (PetscInt)PetscRealPart(globalsum);
3193674ae819SStefano Zampini   /* Fill global_vec with cumulative function for global numbering */
3194674ae819SStefano Zampini   ierr = VecGetArray(global_vec,&array);CHKERRQ(ierr);
3195674ae819SStefano Zampini   ierr = VecGetLocalSize(global_vec,&s);CHKERRQ(ierr);
3196674ae819SStefano Zampini   nlocals = 0;
3197674ae819SStefano Zampini   first_index = -1;
3198674ae819SStefano Zampini   first_found = PETSC_FALSE;
3199674ae819SStefano Zampini   for (i=0;i<s;i++) {
3200b9b85e73SStefano Zampini     if (!first_found && PetscRealPart(array[i]) > 0.1) {
3201674ae819SStefano Zampini       first_found = PETSC_TRUE;
3202674ae819SStefano Zampini       first_index = i;
3203674ae819SStefano Zampini     }
32045b08dc53SStefano Zampini     nlocals += (PetscInt)PetscRealPart(array[i]);
3205674ae819SStefano Zampini   }
3206674ae819SStefano Zampini   ierr = MPI_Gather(&nlocals,1,MPIU_INT,dof_sizes,1,MPIU_INT,0,comm);CHKERRQ(ierr);
3207674ae819SStefano Zampini   if (!rank_prec_comm) {
3208674ae819SStefano Zampini     dof_displs[0]=0;
3209674ae819SStefano Zampini     for (i=1;i<size_prec_comm;i++) {
3210674ae819SStefano Zampini       dof_displs[i] = dof_displs[i-1]+dof_sizes[i-1];
3211674ae819SStefano Zampini     }
3212674ae819SStefano Zampini   }
3213674ae819SStefano Zampini   ierr = MPI_Scatter(dof_displs,1,MPIU_INT,&nlocals,1,MPIU_INT,0,comm);CHKERRQ(ierr);
3214674ae819SStefano Zampini   if (first_found) {
3215674ae819SStefano Zampini     array[first_index] += (PetscScalar)nlocals;
3216674ae819SStefano Zampini     old_index = first_index;
3217674ae819SStefano Zampini     for (i=first_index+1;i<s;i++) {
3218b9b85e73SStefano Zampini       if (PetscRealPart(array[i]) > 0.1) {
3219674ae819SStefano Zampini         array[i] += array[old_index];
3220674ae819SStefano Zampini         old_index = i;
3221674ae819SStefano Zampini       }
3222674ae819SStefano Zampini     }
3223674ae819SStefano Zampini   }
3224674ae819SStefano Zampini   ierr = VecRestoreArray(global_vec,&array);CHKERRQ(ierr);
3225674ae819SStefano Zampini   ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
3226674ae819SStefano Zampini   ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3227674ae819SStefano Zampini   ierr = VecScatterEnd(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
3228674ae819SStefano Zampini   /* get global ordering of local dofs */
32292b095fd8SStefano Zampini   ierr = VecGetArrayRead(local_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
3230674ae819SStefano Zampini   if (local_dofs_mult) {
3231674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
32325b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-local_dofs_mult[i];
3233674ae819SStefano Zampini     }
3234674ae819SStefano Zampini   } else {
3235674ae819SStefano Zampini     for (i=0;i<n_local_dofs;i++) {
32365b08dc53SStefano Zampini       temp_global_dofs[i] = (PetscInt)PetscRealPart(array[local_dofs[i]])-1;
3237674ae819SStefano Zampini     }
3238674ae819SStefano Zampini   }
32392b095fd8SStefano Zampini   ierr = VecRestoreArrayRead(local_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
3240674ae819SStefano Zampini   /* free workspace */
3241674ae819SStefano Zampini   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
3242674ae819SStefano Zampini   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
3243674ae819SStefano Zampini   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
3244674ae819SStefano Zampini   ierr = PetscFree(dof_sizes);CHKERRQ(ierr);
3245674ae819SStefano Zampini   ierr = PetscFree(dof_displs);CHKERRQ(ierr);
3246674ae819SStefano Zampini   /* return pointer to global ordering of local dofs */
3247674ae819SStefano Zampini   *global_numbering_subset = temp_global_dofs;
3248674ae819SStefano Zampini   PetscFunctionReturn(0);
3249674ae819SStefano Zampini }
32509a7d3425SStefano Zampini 
32519a7d3425SStefano Zampini #undef __FUNCT__
32529a7d3425SStefano Zampini #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
32539a7d3425SStefano Zampini PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
32549a7d3425SStefano Zampini {
32559a7d3425SStefano Zampini   PetscInt       i,j;
32569a7d3425SStefano Zampini   PetscScalar    *alphas;
32579a7d3425SStefano Zampini   PetscErrorCode ierr;
32589a7d3425SStefano Zampini 
32599a7d3425SStefano Zampini   PetscFunctionBegin;
32609a7d3425SStefano Zampini   /* this implements stabilized Gram-Schmidt */
3261785e854fSJed Brown   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
32629a7d3425SStefano Zampini   for (i=0;i<n;i++) {
32639a7d3425SStefano Zampini     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
32649a7d3425SStefano Zampini     if (i<n) { ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],&alphas[i+1]);CHKERRQ(ierr); }
32659a7d3425SStefano Zampini     for (j=i+1;j<n;j++) { ierr = VecAXPY(vecs[j],PetscConj(-alphas[j]),vecs[i]);CHKERRQ(ierr); }
32669a7d3425SStefano Zampini   }
32679a7d3425SStefano Zampini   ierr = PetscFree(alphas);CHKERRQ(ierr);
32689a7d3425SStefano Zampini   PetscFunctionReturn(0);
32699a7d3425SStefano Zampini }
32709a7d3425SStefano Zampini 
3271e7931f94SStefano Zampini #undef __FUNCT__
327270cf5478SStefano Zampini #define __FUNCT__ "MatISGetSubassemblingPattern"
327328143c3dSStefano Zampini PetscErrorCode MatISGetSubassemblingPattern(Mat mat, PetscInt n_subdomains, PetscBool contiguous, IS* is_sends)
3274e7931f94SStefano Zampini {
3275e7931f94SStefano Zampini   Mat             subdomain_adj;
3276e7931f94SStefano Zampini   IS              new_ranks,ranks_send_to;
3277e7931f94SStefano Zampini   MatPartitioning partitioner;
3278e7931f94SStefano Zampini   Mat_IS          *matis;
3279e7931f94SStefano Zampini   PetscInt        n_neighs,*neighs,*n_shared,**shared;
3280e7931f94SStefano Zampini   PetscInt        prank;
3281e7931f94SStefano Zampini   PetscMPIInt     size,rank,color;
3282e7931f94SStefano Zampini   PetscInt        *xadj,*adjncy,*oldranks;
3283e7931f94SStefano Zampini   PetscInt        *adjncy_wgt,*v_wgt,*is_indices,*ranks_send_to_idx;
32843837a79fSStefano Zampini   PetscInt        i,local_size,threshold=0;
3285e7931f94SStefano Zampini   PetscErrorCode  ierr;
32862b510759SStefano Zampini   PetscBool       use_vwgt=PETSC_FALSE,use_square=PETSC_FALSE;
3287e7931f94SStefano Zampini   PetscSubcomm    subcomm;
3288a57a6d2fSStefano Zampini 
3289e7931f94SStefano Zampini   PetscFunctionBegin;
32902b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_square",&use_square,NULL);CHKERRQ(ierr);
32912b510759SStefano Zampini   ierr = PetscOptionsGetBool(NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
32922b510759SStefano Zampini   ierr = PetscOptionsGetInt(NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
3293e7931f94SStefano Zampini 
3294e7931f94SStefano Zampini   /* Get info on mapping */
3295e7931f94SStefano Zampini   matis = (Mat_IS*)(mat->data);
3296e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&local_size);CHKERRQ(ierr);
3297e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingGetInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
3298e7931f94SStefano Zampini 
3299e7931f94SStefano Zampini   /* build local CSR graph of subdomains' connectivity */
3300785e854fSJed Brown   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
3301e7931f94SStefano Zampini   xadj[0] = 0;
3302e7931f94SStefano Zampini   xadj[1] = PetscMax(n_neighs-1,0);
3303785e854fSJed Brown   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
3304785e854fSJed Brown   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
3305e7931f94SStefano Zampini 
33062b510759SStefano Zampini   if (threshold) {
3307d023bfaeSStefano Zampini     PetscInt xadj_count = 0;
33082b510759SStefano Zampini     for (i=1;i<n_neighs;i++) {
3309d023bfaeSStefano Zampini       if (n_shared[i] > threshold) {
3310d023bfaeSStefano Zampini         adjncy[xadj_count] = neighs[i];
3311d023bfaeSStefano Zampini         adjncy_wgt[xadj_count] = n_shared[i];
3312d023bfaeSStefano Zampini         xadj_count++;
3313e7931f94SStefano Zampini       }
3314e7931f94SStefano Zampini     }
3315d023bfaeSStefano Zampini     xadj[1] = xadj_count;
3316c8587f34SStefano Zampini   } else {
3317e7931f94SStefano Zampini     if (xadj[1]) {
3318e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy,&neighs[1],xadj[1]*sizeof(*adjncy));CHKERRQ(ierr);
3319e7931f94SStefano Zampini       ierr = PetscMemcpy(adjncy_wgt,&n_shared[1],xadj[1]*sizeof(*adjncy_wgt));CHKERRQ(ierr);
3320c8587f34SStefano Zampini     }
3321e7931f94SStefano Zampini   }
3322e7931f94SStefano Zampini   ierr = ISLocalToGlobalMappingRestoreInfo(matis->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
3323e7931f94SStefano Zampini   if (use_square) {
3324e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
3325e7931f94SStefano Zampini       adjncy_wgt[i] = adjncy_wgt[i]*adjncy_wgt[i];
3326e7931f94SStefano Zampini     }
3327e7931f94SStefano Zampini   }
3328e7931f94SStefano Zampini   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
3329e7931f94SStefano Zampini 
33303837a79fSStefano Zampini   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
3331e7931f94SStefano Zampini 
3332e7931f94SStefano Zampini   /*
3333e7931f94SStefano Zampini     Restrict work on active processes only.
3334e7931f94SStefano Zampini   */
3335e7931f94SStefano Zampini   ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&subcomm);CHKERRQ(ierr);
3336e7931f94SStefano Zampini   ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
3337e7931f94SStefano Zampini   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
33382b510759SStefano Zampini   ierr = PetscMPIIntCast(!local_size,&color);CHKERRQ(ierr);
3339d3531aaaSJed Brown   ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
3340e7931f94SStefano Zampini   if (color) {
3341e7931f94SStefano Zampini     ierr = PetscFree(xadj);CHKERRQ(ierr);
3342e7931f94SStefano Zampini     ierr = PetscFree(adjncy);CHKERRQ(ierr);
3343e7931f94SStefano Zampini     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
3344c8587f34SStefano Zampini   } else {
334528143c3dSStefano Zampini     PetscInt coarsening_ratio;
3346306c2d5bSBarry Smith     ierr = MPI_Comm_size(PetscSubcommChild(subcomm),&size);CHKERRQ(ierr);
3347785e854fSJed Brown     ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
3348e7931f94SStefano Zampini     prank = rank;
3349306c2d5bSBarry Smith     ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,PetscSubcommChild(subcomm));CHKERRQ(ierr);
33508002ef2cSStefano Zampini     /*
3351e7931f94SStefano Zampini     for (i=0;i<size;i++) {
3352e7931f94SStefano Zampini       PetscPrintf(subcomm->comm,"oldranks[%d] = %d\n",i,oldranks[i]);
3353c8587f34SStefano Zampini     }
33548002ef2cSStefano Zampini     */
3355e7931f94SStefano Zampini     for (i=0;i<xadj[1];i++) {
3356e7931f94SStefano Zampini       ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
3357c8587f34SStefano Zampini     }
3358e7931f94SStefano Zampini     ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
3359306c2d5bSBarry Smith     ierr = MatCreateMPIAdj(PetscSubcommChild(subcomm),1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
336022b6e8a2SStefano Zampini     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
3361e7931f94SStefano Zampini 
3362e7931f94SStefano Zampini     /* Partition */
3363306c2d5bSBarry Smith     ierr = MatPartitioningCreate(PetscSubcommChild(subcomm),&partitioner);CHKERRQ(ierr);
3364e7931f94SStefano Zampini     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
3365e7931f94SStefano Zampini     if (use_vwgt) {
33663837a79fSStefano Zampini       ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
3367e7931f94SStefano Zampini       v_wgt[0] = local_size;
3368e7931f94SStefano Zampini       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
3369c8587f34SStefano Zampini     }
337028143c3dSStefano Zampini     n_subdomains = PetscMin((PetscInt)size,n_subdomains);
337128143c3dSStefano Zampini     coarsening_ratio = size/n_subdomains;
337228143c3dSStefano Zampini     ierr = MatPartitioningSetNParts(partitioner,n_subdomains);CHKERRQ(ierr);
3373e7931f94SStefano Zampini     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
3374e7931f94SStefano Zampini     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
337522b6e8a2SStefano Zampini     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
3376e7931f94SStefano Zampini 
3377e7931f94SStefano Zampini     ierr = ISGetIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
337828143c3dSStefano Zampini     if (contiguous) {
337928143c3dSStefano Zampini       ranks_send_to_idx[0] = oldranks[is_indices[0]]; /* contiguos set of processes */
338028143c3dSStefano Zampini     } else {
338184ba6060SStefano Zampini       ranks_send_to_idx[0] = coarsening_ratio*oldranks[is_indices[0]]; /* scattered set of processes */
338228143c3dSStefano Zampini     }
3383e7931f94SStefano Zampini     ierr = ISRestoreIndices(new_ranks,(const PetscInt**)&is_indices);CHKERRQ(ierr);
3384e7931f94SStefano Zampini     /* clean up */
3385e7931f94SStefano Zampini     ierr = PetscFree(oldranks);CHKERRQ(ierr);
3386e7931f94SStefano Zampini     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
3387e7931f94SStefano Zampini     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
3388e7931f94SStefano Zampini     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
3389e7931f94SStefano Zampini   }
3390e7931f94SStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
3391e7931f94SStefano Zampini 
3392e7931f94SStefano Zampini   /* assemble parallel IS for sends */
3393e7931f94SStefano Zampini   i = 1;
3394e7931f94SStefano Zampini   if (color) i=0;
3395e7931f94SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,&ranks_send_to);CHKERRQ(ierr);
3396e7931f94SStefano Zampini 
3397e7931f94SStefano Zampini   /* get back IS */
3398e7931f94SStefano Zampini   *is_sends = ranks_send_to;
3399e7931f94SStefano Zampini   PetscFunctionReturn(0);
3400e7931f94SStefano Zampini }
3401e7931f94SStefano Zampini 
3402e7931f94SStefano Zampini typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
3403e7931f94SStefano Zampini 
3404e7931f94SStefano Zampini #undef __FUNCT__
3405e7931f94SStefano Zampini #define __FUNCT__ "MatISSubassemble"
340628143c3dSStefano Zampini PetscErrorCode MatISSubassemble(Mat mat, IS is_sends, PetscInt n_subdomains, PetscBool restrict_comm, MatReuse reuse, Mat *mat_n, PetscInt nis, IS isarray[])
3407e7931f94SStefano Zampini {
340870cf5478SStefano Zampini   Mat                    local_mat;
3409e7931f94SStefano Zampini   Mat_IS                 *matis;
3410e7931f94SStefano Zampini   IS                     is_sends_internal;
34119d30be91SStefano Zampini   PetscInt               rows,cols,new_local_rows;
341228143c3dSStefano Zampini   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals;
34139d30be91SStefano Zampini   PetscBool              ismatis,isdense,newisdense,destroy_mat;
3414e7931f94SStefano Zampini   ISLocalToGlobalMapping l2gmap;
3415e7931f94SStefano Zampini   PetscInt*              l2gmap_indices;
3416e7931f94SStefano Zampini   const PetscInt*        is_indices;
3417e7931f94SStefano Zampini   MatType                new_local_type;
3418e7931f94SStefano Zampini   /* buffers */
3419e7931f94SStefano Zampini   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
342028143c3dSStefano Zampini   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
34219d30be91SStefano Zampini   PetscInt               *recv_buffer_idxs_local;
3422e7931f94SStefano Zampini   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
3423e7931f94SStefano Zampini   /* MPI */
342428143c3dSStefano Zampini   MPI_Comm               comm,comm_n;
342528143c3dSStefano Zampini   PetscSubcomm           subcomm;
3426e7931f94SStefano Zampini   PetscMPIInt            n_sends,n_recvs,commsize;
342728143c3dSStefano Zampini   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
342828143c3dSStefano Zampini   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
342928143c3dSStefano Zampini   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,source_dest;
343028143c3dSStefano Zampini   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals;
343128143c3dSStefano Zampini   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals;
3432e7931f94SStefano Zampini   PetscErrorCode         ierr;
3433e7931f94SStefano Zampini 
3434e7931f94SStefano Zampini   PetscFunctionBegin;
343528143c3dSStefano Zampini   /* TODO: add missing checks */
343628143c3dSStefano Zampini   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
343728143c3dSStefano Zampini   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
343828143c3dSStefano Zampini   PetscValidLogicalCollectiveEnum(mat,reuse,5);
343928143c3dSStefano Zampini   PetscValidLogicalCollectiveInt(mat,nis,7);
3440e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
344128143c3dSStefano Zampini   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",__FUNCT__);
3442e7931f94SStefano Zampini   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
3443e7931f94SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
3444e7931f94SStefano Zampini   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
3445e7931f94SStefano Zampini   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
3446e7931f94SStefano Zampini   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
344728143c3dSStefano Zampini   if (reuse == MAT_REUSE_MATRIX && *mat_n) {
344870cf5478SStefano Zampini     PetscInt mrows,mcols,mnrows,mncols;
344970cf5478SStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
345028143c3dSStefano Zampini     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
345170cf5478SStefano Zampini     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
345270cf5478SStefano Zampini     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
345370cf5478SStefano Zampini     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
345470cf5478SStefano Zampini     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
345570cf5478SStefano Zampini   }
3456e7931f94SStefano Zampini   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
3457e7931f94SStefano Zampini   PetscValidLogicalCollectiveInt(mat,bs,0);
3458e7931f94SStefano Zampini   /* prepare IS for sending if not provided */
3459e7931f94SStefano Zampini   if (!is_sends) {
346028143c3dSStefano Zampini     PetscBool pcontig = PETSC_TRUE;
346128143c3dSStefano Zampini     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
346228143c3dSStefano Zampini     ierr = MatISGetSubassemblingPattern(mat,n_subdomains,pcontig,&is_sends_internal);CHKERRQ(ierr);
3463c8587f34SStefano Zampini   } else {
3464e7931f94SStefano Zampini     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
3465e7931f94SStefano Zampini     is_sends_internal = is_sends;
3466c8587f34SStefano Zampini   }
3467e7931f94SStefano Zampini 
3468e7931f94SStefano Zampini   /* get pointer of MATIS data */
3469e7931f94SStefano Zampini   matis = (Mat_IS*)mat->data;
3470e7931f94SStefano Zampini 
3471e7931f94SStefano Zampini   /* get comm */
3472a316fed8SStefano Zampini   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
3473e7931f94SStefano Zampini 
3474e7931f94SStefano Zampini   /* compute number of sends */
3475e7931f94SStefano Zampini   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
3476e7931f94SStefano Zampini   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
3477e7931f94SStefano Zampini 
3478e7931f94SStefano Zampini   /* compute number of receives */
3479e7931f94SStefano Zampini   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
3480785e854fSJed Brown   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
3481e7931f94SStefano Zampini   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
3482e7931f94SStefano Zampini   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
3483e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
3484e7931f94SStefano Zampini   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
3485e7931f94SStefano Zampini   ierr = PetscFree(iflags);CHKERRQ(ierr);
3486e7931f94SStefano Zampini 
348728143c3dSStefano Zampini   /* restrict comm if requested */
348828143c3dSStefano Zampini   subcomm = 0;
348928143c3dSStefano Zampini   destroy_mat = PETSC_FALSE;
349028143c3dSStefano Zampini   if (restrict_comm) {
3491779c1cceSStefano Zampini     PetscMPIInt color,subcommsize;
3492779c1cceSStefano Zampini 
349328143c3dSStefano Zampini     color = 0;
3494779c1cceSStefano Zampini     if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm */
349528143c3dSStefano Zampini     ierr = MPI_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
349628143c3dSStefano Zampini     subcommsize = commsize - subcommsize;
349728143c3dSStefano Zampini     /* check if reuse has been requested */
349828143c3dSStefano Zampini     if (reuse == MAT_REUSE_MATRIX) {
349928143c3dSStefano Zampini       if (*mat_n) {
350028143c3dSStefano Zampini         PetscMPIInt subcommsize2;
350128143c3dSStefano Zampini         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
350228143c3dSStefano Zampini         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
350328143c3dSStefano Zampini         comm_n = PetscObjectComm((PetscObject)*mat_n);
350428143c3dSStefano Zampini       } else {
350528143c3dSStefano Zampini         comm_n = PETSC_COMM_SELF;
350628143c3dSStefano Zampini       }
350728143c3dSStefano Zampini     } else { /* MAT_INITIAL_MATRIX */
3508779c1cceSStefano Zampini       PetscMPIInt rank;
3509779c1cceSStefano Zampini 
3510779c1cceSStefano Zampini       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
351128143c3dSStefano Zampini       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
351228143c3dSStefano Zampini       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
351328143c3dSStefano Zampini       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
3514306c2d5bSBarry Smith       comm_n = PetscSubcommChild(subcomm);
351528143c3dSStefano Zampini     }
351628143c3dSStefano Zampini     /* flag to destroy *mat_n if not significative */
351728143c3dSStefano Zampini     if (color) destroy_mat = PETSC_TRUE;
351828143c3dSStefano Zampini   } else {
351928143c3dSStefano Zampini     comm_n = comm;
352028143c3dSStefano Zampini   }
352128143c3dSStefano Zampini 
3522e7931f94SStefano Zampini   /* prepare send/receive buffers */
3523785e854fSJed Brown   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
3524e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
3525785e854fSJed Brown   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
3526e7931f94SStefano Zampini   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
352728143c3dSStefano Zampini   if (nis) {
3528854ce69bSBarry Smith     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
352928143c3dSStefano Zampini   }
3530e7931f94SStefano Zampini 
353128143c3dSStefano Zampini   /* Get data from local matrices */
3532e7931f94SStefano Zampini   if (!isdense) {
3533a26c9d0eSStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
3534e7931f94SStefano Zampini     /* TODO: See below some guidelines on how to prepare the local buffers */
3535e7931f94SStefano Zampini     /*
3536e7931f94SStefano Zampini        send_buffer_vals should contain the raw values of the local matrix
3537e7931f94SStefano Zampini        send_buffer_idxs should contain:
3538e7931f94SStefano Zampini        - MatType_PRIVATE type
3539e7931f94SStefano Zampini        - PetscInt        size_of_l2gmap
3540e7931f94SStefano Zampini        - PetscInt        global_row_indices[size_of_l2gmap]
3541e7931f94SStefano Zampini        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
3542e7931f94SStefano Zampini     */
3543e7931f94SStefano Zampini   } else {
3544e7931f94SStefano Zampini     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
3545e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetSize(matis->mapping,&i);CHKERRQ(ierr);
3546854ce69bSBarry Smith     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
3547e7931f94SStefano Zampini     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
3548e7931f94SStefano Zampini     send_buffer_idxs[1] = i;
3549e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingGetIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
3550e7931f94SStefano Zampini     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
3551e7931f94SStefano Zampini     ierr = ISLocalToGlobalMappingRestoreIndices(matis->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
3552e7931f94SStefano Zampini     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
3553e7931f94SStefano Zampini     for (i=0;i<n_sends;i++) {
3554e7931f94SStefano Zampini       ilengths_vals[is_indices[i]] = len*len;
3555e7931f94SStefano Zampini       ilengths_idxs[is_indices[i]] = len+2;
3556c8587f34SStefano Zampini     }
3557c8587f34SStefano Zampini   }
3558e7931f94SStefano Zampini   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
355928143c3dSStefano Zampini   /* additional is (if any) */
356028143c3dSStefano Zampini   if (nis) {
356128143c3dSStefano Zampini     PetscMPIInt psum;
356228143c3dSStefano Zampini     PetscInt j;
356328143c3dSStefano Zampini     for (j=0,psum=0;j<nis;j++) {
356428143c3dSStefano Zampini       PetscInt plen;
356528143c3dSStefano Zampini       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
356628143c3dSStefano Zampini       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
356728143c3dSStefano Zampini       psum += len+1; /* indices + lenght */
356828143c3dSStefano Zampini     }
3569854ce69bSBarry Smith     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
357028143c3dSStefano Zampini     for (j=0,psum=0;j<nis;j++) {
357128143c3dSStefano Zampini       PetscInt plen;
357228143c3dSStefano Zampini       const PetscInt *is_array_idxs;
357328143c3dSStefano Zampini       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
357428143c3dSStefano Zampini       send_buffer_idxs_is[psum] = plen;
357528143c3dSStefano Zampini       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
357628143c3dSStefano Zampini       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
357728143c3dSStefano Zampini       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
357828143c3dSStefano Zampini       psum += plen+1; /* indices + lenght */
357928143c3dSStefano Zampini     }
358028143c3dSStefano Zampini     for (i=0;i<n_sends;i++) {
358128143c3dSStefano Zampini       ilengths_idxs_is[is_indices[i]] = psum;
358228143c3dSStefano Zampini     }
358328143c3dSStefano Zampini     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
358428143c3dSStefano Zampini   }
358528143c3dSStefano Zampini 
3586e7931f94SStefano Zampini   buf_size_idxs = 0;
3587e7931f94SStefano Zampini   buf_size_vals = 0;
358828143c3dSStefano Zampini   buf_size_idxs_is = 0;
3589e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3590e7931f94SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
3591e7931f94SStefano Zampini     buf_size_vals += (PetscInt)olengths_vals[i];
359228143c3dSStefano Zampini     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
3593e7931f94SStefano Zampini   }
3594785e854fSJed Brown   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
3595785e854fSJed Brown   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
359695ecbf38SStefano Zampini   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
3597e7931f94SStefano Zampini 
3598e7931f94SStefano Zampini   /* get new tags for clean communications */
3599e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
3600e7931f94SStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
360128143c3dSStefano Zampini   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
3602e7931f94SStefano Zampini 
3603e7931f94SStefano Zampini   /* allocate for requests */
3604785e854fSJed Brown   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
3605785e854fSJed Brown   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
360695ecbf38SStefano Zampini   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
3607785e854fSJed Brown   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
3608785e854fSJed Brown   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
360995ecbf38SStefano Zampini   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
3610e7931f94SStefano Zampini 
3611e7931f94SStefano Zampini   /* communications */
3612e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
3613e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
361428143c3dSStefano Zampini   ptr_idxs_is = recv_buffer_idxs_is;
3615e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3616e7931f94SStefano Zampini     source_dest = onodes[i];
3617e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
3618e7931f94SStefano Zampini     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
3619e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3620e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
362128143c3dSStefano Zampini     if (nis) {
362228143c3dSStefano 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);
362328143c3dSStefano Zampini       ptr_idxs_is += olengths_idxs_is[i];
362428143c3dSStefano Zampini     }
3625e7931f94SStefano Zampini   }
3626e7931f94SStefano Zampini   for (i=0;i<n_sends;i++) {
3627e7931f94SStefano Zampini     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
3628e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
3629e7931f94SStefano Zampini     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
363028143c3dSStefano Zampini     if (nis) {
363128143c3dSStefano 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);
363228143c3dSStefano Zampini     }
3633e7931f94SStefano Zampini   }
3634e7931f94SStefano Zampini   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
3635e7931f94SStefano Zampini   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
3636e7931f94SStefano Zampini 
3637e7931f94SStefano Zampini   /* assemble new l2g map */
3638e7931f94SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3639e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
36409d30be91SStefano Zampini   new_local_rows = 0;
3641e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
36429d30be91SStefano Zampini     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
3643e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3644e7931f94SStefano Zampini   }
36459d30be91SStefano Zampini   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
3646e7931f94SStefano Zampini   ptr_idxs = recv_buffer_idxs;
36479d30be91SStefano Zampini   new_local_rows = 0;
3648e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
36499d30be91SStefano Zampini     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
36509d30be91SStefano Zampini     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
3651e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3652e7931f94SStefano Zampini   }
36539d30be91SStefano Zampini   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
36549d30be91SStefano Zampini   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
3655e7931f94SStefano Zampini   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
3656e7931f94SStefano Zampini 
3657e7931f94SStefano Zampini   /* infer new local matrix type from received local matrices type */
3658e7931f94SStefano Zampini   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
3659e7931f94SStefano 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) */
3660e7931f94SStefano Zampini   if (n_recvs) {
366128143c3dSStefano Zampini     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
3662e7931f94SStefano Zampini     ptr_idxs = recv_buffer_idxs;
3663e7931f94SStefano Zampini     for (i=0;i<n_recvs;i++) {
3664e7931f94SStefano Zampini       if ((PetscInt)new_local_type_private != *ptr_idxs) {
3665e7931f94SStefano Zampini         new_local_type_private = MATAIJ_PRIVATE;
3666e7931f94SStefano Zampini         break;
3667e7931f94SStefano Zampini       }
3668e7931f94SStefano Zampini       ptr_idxs += olengths_idxs[i];
3669e7931f94SStefano Zampini     }
3670e7931f94SStefano Zampini     switch (new_local_type_private) {
367128143c3dSStefano Zampini       case MATDENSE_PRIVATE:
367228143c3dSStefano Zampini         if (n_recvs>1) { /* subassembling of dense matrices does not give a dense matrix! */
3673e7931f94SStefano Zampini           new_local_type = MATSEQAIJ;
3674e7931f94SStefano Zampini           bs = 1;
367528143c3dSStefano Zampini         } else { /* if I receive only 1 dense matrix */
367628143c3dSStefano Zampini           new_local_type = MATSEQDENSE;
367728143c3dSStefano Zampini           bs = 1;
367828143c3dSStefano Zampini         }
3679e7931f94SStefano Zampini         break;
3680e7931f94SStefano Zampini       case MATAIJ_PRIVATE:
3681e7931f94SStefano Zampini         new_local_type = MATSEQAIJ;
3682e7931f94SStefano Zampini         bs = 1;
3683e7931f94SStefano Zampini         break;
3684e7931f94SStefano Zampini       case MATBAIJ_PRIVATE:
3685e7931f94SStefano Zampini         new_local_type = MATSEQBAIJ;
3686e7931f94SStefano Zampini         break;
3687e7931f94SStefano Zampini       case MATSBAIJ_PRIVATE:
3688e7931f94SStefano Zampini         new_local_type = MATSEQSBAIJ;
3689e7931f94SStefano Zampini         break;
3690e7931f94SStefano Zampini       default:
36919d30be91SStefano Zampini         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,__FUNCT__);
3692e7931f94SStefano Zampini         break;
3693e7931f94SStefano Zampini     }
369428143c3dSStefano Zampini   } else { /* by default, new_local_type is seqdense */
369528143c3dSStefano Zampini     new_local_type = MATSEQDENSE;
369628143c3dSStefano Zampini     bs = 1;
3697e7931f94SStefano Zampini   }
3698e7931f94SStefano Zampini 
369970cf5478SStefano Zampini   /* create MATIS object if needed */
370070cf5478SStefano Zampini   if (reuse == MAT_INITIAL_MATRIX) {
3701e7931f94SStefano Zampini     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
370228143c3dSStefano Zampini     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,mat_n);CHKERRQ(ierr);
370370cf5478SStefano Zampini   } else {
370470cf5478SStefano Zampini     /* it also destroys the local matrices */
370570cf5478SStefano Zampini     ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
370670cf5478SStefano Zampini   }
370770cf5478SStefano Zampini   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
3708e7931f94SStefano Zampini   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
37099d30be91SStefano Zampini 
37109d30be91SStefano Zampini   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
37119d30be91SStefano Zampini 
37129d30be91SStefano Zampini   /* Global to local map of received indices */
37139d30be91SStefano Zampini   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
37149d30be91SStefano Zampini   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
37159d30be91SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
37169d30be91SStefano Zampini 
37179d30be91SStefano Zampini   /* restore attributes -> type of incoming data and its size */
37189d30be91SStefano Zampini   buf_size_idxs = 0;
37199d30be91SStefano Zampini   for (i=0;i<n_recvs;i++) {
37209d30be91SStefano Zampini     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
37219d30be91SStefano Zampini     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
37229d30be91SStefano Zampini     buf_size_idxs += (PetscInt)olengths_idxs[i];
37239d30be91SStefano Zampini   }
37249d30be91SStefano Zampini   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
37259d30be91SStefano Zampini 
37269d30be91SStefano Zampini   /* set preallocation */
37279d30be91SStefano Zampini   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
37289d30be91SStefano Zampini   if (!newisdense) {
37299d30be91SStefano Zampini     PetscInt *new_local_nnz=0;
37309d30be91SStefano Zampini 
37319d30be91SStefano Zampini     ptr_vals = recv_buffer_vals;
37329d30be91SStefano Zampini     ptr_idxs = recv_buffer_idxs_local;
37339d30be91SStefano Zampini     if (n_recvs) {
37349d30be91SStefano Zampini       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
37359d30be91SStefano Zampini     }
37369d30be91SStefano Zampini     for (i=0;i<n_recvs;i++) {
37379d30be91SStefano Zampini       PetscInt j;
37389d30be91SStefano Zampini       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
37399d30be91SStefano Zampini         for (j=0;j<*(ptr_idxs+1);j++) {
37409d30be91SStefano Zampini           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
37419d30be91SStefano Zampini         }
37429d30be91SStefano Zampini       } else {
37439d30be91SStefano Zampini         /* TODO */
37449d30be91SStefano Zampini       }
37459d30be91SStefano Zampini       ptr_idxs += olengths_idxs[i];
37469d30be91SStefano Zampini     }
37479d30be91SStefano Zampini     if (new_local_nnz) {
37489d30be91SStefano Zampini       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
37499d30be91SStefano Zampini       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
37509d30be91SStefano Zampini       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
37519d30be91SStefano Zampini       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
37529d30be91SStefano Zampini       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
37539d30be91SStefano Zampini       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
37549d30be91SStefano Zampini     } else {
37559d30be91SStefano Zampini       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
37569d30be91SStefano Zampini     }
37579d30be91SStefano Zampini     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
37589d30be91SStefano Zampini   } else {
37599d30be91SStefano Zampini     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
37609d30be91SStefano Zampini   }
3761e7931f94SStefano Zampini 
3762e7931f94SStefano Zampini   /* set values */
3763e7931f94SStefano Zampini   ptr_vals = recv_buffer_vals;
37649d30be91SStefano Zampini   ptr_idxs = recv_buffer_idxs_local;
3765e7931f94SStefano Zampini   for (i=0;i<n_recvs;i++) {
3766e7931f94SStefano Zampini     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
3767e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
37689d30be91SStefano Zampini       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
3769e7931f94SStefano Zampini       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3770e7931f94SStefano Zampini       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
3771e7931f94SStefano Zampini       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
377228143c3dSStefano Zampini     } else {
377328143c3dSStefano Zampini       /* TODO */
3774e7931f94SStefano Zampini     }
3775e7931f94SStefano Zampini     ptr_idxs += olengths_idxs[i];
3776e7931f94SStefano Zampini     ptr_vals += olengths_vals[i];
3777e7931f94SStefano Zampini   }
3778e7931f94SStefano Zampini   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3779e7931f94SStefano Zampini   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
378070cf5478SStefano Zampini   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
378170cf5478SStefano Zampini   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
37829d30be91SStefano Zampini   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
37839d30be91SStefano Zampini   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
3784e7931f94SStefano Zampini 
3785dfd14d43SStefano Zampini #if 0
378628143c3dSStefano Zampini   if (!restrict_comm) { /* check */
3787e7931f94SStefano Zampini     Vec       lvec,rvec;
3788e7931f94SStefano Zampini     PetscReal infty_error;
3789e7931f94SStefano Zampini 
37902a7a6963SBarry Smith     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
3791e7931f94SStefano Zampini     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
3792e7931f94SStefano Zampini     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
3793e7931f94SStefano Zampini     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
379470cf5478SStefano Zampini     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
3795e7931f94SStefano Zampini     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
3796e7931f94SStefano Zampini     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
3797e7931f94SStefano Zampini     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
3798e7931f94SStefano Zampini     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
3799e7931f94SStefano Zampini   }
380028143c3dSStefano Zampini #endif
3801e7931f94SStefano Zampini 
380228143c3dSStefano Zampini   /* assemble new additional is (if any) */
380328143c3dSStefano Zampini   if (nis) {
380428143c3dSStefano Zampini     PetscInt **temp_idxs,*count_is,j,psum;
380528143c3dSStefano Zampini 
380628143c3dSStefano Zampini     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3807854ce69bSBarry Smith     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
380828143c3dSStefano Zampini     ptr_idxs = recv_buffer_idxs_is;
380928143c3dSStefano Zampini     psum = 0;
381028143c3dSStefano Zampini     for (i=0;i<n_recvs;i++) {
381128143c3dSStefano Zampini       for (j=0;j<nis;j++) {
381228143c3dSStefano Zampini         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
381328143c3dSStefano Zampini         count_is[j] += plen; /* increment counting of buffer for j-th IS */
381428143c3dSStefano Zampini         psum += plen;
381528143c3dSStefano Zampini         ptr_idxs += plen+1; /* shift pointer to received data */
381628143c3dSStefano Zampini       }
381728143c3dSStefano Zampini     }
3818854ce69bSBarry Smith     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
3819854ce69bSBarry Smith     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
382028143c3dSStefano Zampini     for (i=1;i<nis;i++) {
382128143c3dSStefano Zampini       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
382228143c3dSStefano Zampini     }
382328143c3dSStefano Zampini     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
382428143c3dSStefano Zampini     ptr_idxs = recv_buffer_idxs_is;
382528143c3dSStefano Zampini     for (i=0;i<n_recvs;i++) {
382628143c3dSStefano Zampini       for (j=0;j<nis;j++) {
382728143c3dSStefano Zampini         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
382828143c3dSStefano Zampini         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
382928143c3dSStefano Zampini         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
383028143c3dSStefano Zampini         ptr_idxs += plen+1; /* shift pointer to received data */
383128143c3dSStefano Zampini       }
383228143c3dSStefano Zampini     }
383328143c3dSStefano Zampini     for (i=0;i<nis;i++) {
383428143c3dSStefano Zampini       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
383528143c3dSStefano Zampini       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
383628143c3dSStefano Zampini       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
383728143c3dSStefano Zampini     }
383828143c3dSStefano Zampini     ierr = PetscFree(count_is);CHKERRQ(ierr);
383928143c3dSStefano Zampini     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
384028143c3dSStefano Zampini     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
384128143c3dSStefano Zampini   }
3842e7931f94SStefano Zampini   /* free workspace */
384328143c3dSStefano Zampini   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
3844e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3845e7931f94SStefano Zampini   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
3846e7931f94SStefano Zampini   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
3847e7931f94SStefano Zampini   if (isdense) {
3848e7931f94SStefano Zampini     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
3849e7931f94SStefano Zampini     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
3850e7931f94SStefano Zampini   } else {
3851e7931f94SStefano Zampini     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
3852e7931f94SStefano Zampini   }
385328143c3dSStefano Zampini   if (nis) {
385428143c3dSStefano Zampini     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
385528143c3dSStefano Zampini     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
385628143c3dSStefano Zampini   }
3857e7931f94SStefano Zampini   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
3858e7931f94SStefano Zampini   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
385928143c3dSStefano Zampini   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
3860e7931f94SStefano Zampini   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
3861e7931f94SStefano Zampini   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
386228143c3dSStefano Zampini   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
3863e7931f94SStefano Zampini   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
3864e7931f94SStefano Zampini   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
3865e7931f94SStefano Zampini   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
3866e7931f94SStefano Zampini   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
3867e7931f94SStefano Zampini   ierr = PetscFree(onodes);CHKERRQ(ierr);
386828143c3dSStefano Zampini   if (nis) {
386928143c3dSStefano Zampini     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
387028143c3dSStefano Zampini     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
387128143c3dSStefano Zampini     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
387228143c3dSStefano Zampini   }
387328143c3dSStefano Zampini   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
387428143c3dSStefano Zampini   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
387528143c3dSStefano Zampini     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
387628143c3dSStefano Zampini     for (i=0;i<nis;i++) {
387728143c3dSStefano Zampini       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
387828143c3dSStefano Zampini     }
387928143c3dSStefano Zampini   }
3880e7931f94SStefano Zampini   PetscFunctionReturn(0);
3881e7931f94SStefano Zampini }
3882a57a6d2fSStefano Zampini 
388312edc857SStefano Zampini /* temporary hack into ksp private data structure */
388412edc857SStefano Zampini #include <petsc-private/kspimpl.h>
388512edc857SStefano Zampini 
3886c8587f34SStefano Zampini #undef __FUNCT__
3887c8587f34SStefano Zampini #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
3888c8587f34SStefano Zampini PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
3889c8587f34SStefano Zampini {
3890c8587f34SStefano Zampini   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
3891c8587f34SStefano Zampini   PC_IS                  *pcis = (PC_IS*)pc->data;
389220a2ab83SStefano Zampini   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
38939881197aSStefano Zampini   MatNullSpace           CoarseNullSpace=NULL;
389420a2ab83SStefano Zampini   ISLocalToGlobalMapping coarse_islg;
38956e683305SStefano Zampini   IS                     coarse_is,*isarray;
38966e683305SStefano Zampini   PetscInt               i,im_active=-1,active_procs=-1;
38976e683305SStefano Zampini   PetscInt               nis,nisdofs,nisneu;
3898f9eb5b7dSStefano Zampini   PC                     pc_temp;
3899c8587f34SStefano Zampini   PCType                 coarse_pc_type;
3900c8587f34SStefano Zampini   KSPType                coarse_ksp_type;
3901f9eb5b7dSStefano Zampini   PetscBool              multilevel_requested,multilevel_allowed;
39024f3a063dSStefano Zampini   PetscBool              isredundant,isbddc,isnn,coarse_reuse;
39036e683305SStefano Zampini   Mat                    t_coarse_mat_is;
39046e683305SStefano Zampini   PetscInt               void_procs,ncoarse_ml,ncoarse_ds,ncoarse;
39056e683305SStefano Zampini   PetscMPIInt            all_procs;
390674e2c79eSStefano Zampini   PetscBool              csin_ml,csin_ds,csin,csin_type_simple,redist;
390768457ee5SStefano Zampini   PetscBool              compute_vecs = PETSC_FALSE;
390822bc73bbSStefano Zampini   PetscScalar            *array;
39099881197aSStefano Zampini   PetscErrorCode         ierr;
3910fdc09c96SStefano Zampini 
3911c8587f34SStefano Zampini   PetscFunctionBegin;
3912c8587f34SStefano Zampini   /* Assign global numbering to coarse dofs */
391368457ee5SStefano 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 */
3914fa7f1dd8SStefano Zampini     PetscInt ocoarse_size;
39155a75c04eSSatish Balay     compute_vecs = PETSC_TRUE;
3916fa7f1dd8SStefano Zampini     ocoarse_size = pcbddc->coarse_size;
3917f4ddd8eeSStefano Zampini     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3918f4ddd8eeSStefano Zampini     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
3919f4ddd8eeSStefano Zampini     /* see if we can avoid some work */
3920fa7f1dd8SStefano Zampini     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
3921fa7f1dd8SStefano Zampini       if (ocoarse_size != pcbddc->coarse_size) { /* ...but with different size, so reset it and set reuse flag to false */
3922727cdba6SStefano Zampini         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3923fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_FALSE;
3924fa7f1dd8SStefano Zampini       } else { /* we can safely reuse already computed coarse matrix */
3925fa7f1dd8SStefano Zampini         coarse_reuse = PETSC_TRUE;
3926f4ddd8eeSStefano Zampini       }
3927fa7f1dd8SStefano Zampini     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
3928fa7f1dd8SStefano Zampini       coarse_reuse = PETSC_FALSE;
3929f4ddd8eeSStefano Zampini     }
393070cf5478SStefano Zampini     /* reset any subassembling information */
393170cf5478SStefano Zampini     ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
39326e683305SStefano Zampini     ierr = ISDestroy(&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
39336e683305SStefano Zampini   } else { /* primal space is unchanged, so we can reuse coarse matrix */
3934fa7f1dd8SStefano Zampini     coarse_reuse = PETSC_TRUE;
3935f4ddd8eeSStefano Zampini   }
3936c8587f34SStefano Zampini 
39376e683305SStefano Zampini   /* count "active" (i.e. with positive local size) and "void" processes */
39382b510759SStefano Zampini   im_active = !!(pcis->n);
39392b510759SStefano Zampini   ierr = MPI_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
39406e683305SStefano Zampini   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&all_procs);CHKERRQ(ierr);
39416e683305SStefano Zampini   void_procs = all_procs-active_procs;
39426e683305SStefano Zampini   csin_type_simple = PETSC_TRUE;
394374e2c79eSStefano Zampini   redist = PETSC_FALSE;
394422bc73bbSStefano Zampini   if (pcbddc->current_level && void_procs) {
39456e683305SStefano Zampini     csin_ml = PETSC_TRUE;
39466e683305SStefano Zampini     ncoarse_ml = void_procs;
3947779c1cceSStefano Zampini     /* it has no sense to redistribute on a set of processors larger than the number of active processes */
3948779c1cceSStefano Zampini     if (pcbddc->redistribute_coarse > 0 && pcbddc->redistribute_coarse < active_procs) {
394918a45a71SStefano Zampini       csin_ds = PETSC_TRUE;
395018a45a71SStefano Zampini       ncoarse_ds = pcbddc->redistribute_coarse;
395118a45a71SStefano Zampini       redist = PETSC_TRUE;
395218a45a71SStefano Zampini     } else {
39536e683305SStefano Zampini       csin_ds = PETSC_TRUE;
3954779c1cceSStefano Zampini       ncoarse_ds = active_procs;
3955779c1cceSStefano Zampini       redist = PETSC_TRUE;
395618a45a71SStefano Zampini     }
39576e683305SStefano Zampini   } else {
39586e683305SStefano Zampini     csin_ml = PETSC_FALSE;
39596e683305SStefano Zampini     ncoarse_ml = all_procs;
39606e683305SStefano Zampini     if (void_procs) {
39616e683305SStefano Zampini       csin_ds = PETSC_TRUE;
39626e683305SStefano Zampini       ncoarse_ds = void_procs;
39636e683305SStefano Zampini       csin_type_simple = PETSC_FALSE;
39646e683305SStefano Zampini     } else {
3965779c1cceSStefano Zampini       if (pcbddc->redistribute_coarse > 0 && pcbddc->redistribute_coarse < all_procs) {
396674e2c79eSStefano Zampini         csin_ds = PETSC_TRUE;
396774e2c79eSStefano Zampini         ncoarse_ds = pcbddc->redistribute_coarse;
396874e2c79eSStefano Zampini         redist = PETSC_TRUE;
396974e2c79eSStefano Zampini       } else {
39706e683305SStefano Zampini         csin_ds = PETSC_FALSE;
39716e683305SStefano Zampini         ncoarse_ds = all_procs;
39726e683305SStefano Zampini       }
39736e683305SStefano Zampini     }
397474e2c79eSStefano Zampini   }
39756e683305SStefano Zampini 
39766e683305SStefano Zampini   /*
39776e683305SStefano Zampini     test if we can go multilevel: three conditions must be satisfied:
39786e683305SStefano Zampini     - we have not exceeded the number of levels requested
39796e683305SStefano Zampini     - we can actually subassemble the active processes
39806e683305SStefano Zampini     - we can find a suitable number of MPI processes where we can place the subassembled problem
39816e683305SStefano Zampini   */
39826e683305SStefano Zampini   multilevel_allowed = PETSC_FALSE;
39836e683305SStefano Zampini   multilevel_requested = PETSC_FALSE;
39846e683305SStefano Zampini   if (pcbddc->current_level < pcbddc->max_levels) {
39856e683305SStefano Zampini     multilevel_requested = PETSC_TRUE;
39866e683305SStefano Zampini     if (active_procs/pcbddc->coarsening_ratio < 2 || ncoarse_ml/pcbddc->coarsening_ratio < 2) {
3987f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_FALSE;
39882b510759SStefano Zampini     } else {
3989f9eb5b7dSStefano Zampini       multilevel_allowed = PETSC_TRUE;
3990c8587f34SStefano Zampini     }
3991c8587f34SStefano Zampini   }
39926e683305SStefano Zampini   /* determine number of process partecipating to coarse solver */
39936e683305SStefano Zampini   if (multilevel_allowed) {
39946e683305SStefano Zampini     ncoarse = ncoarse_ml;
39956e683305SStefano Zampini     csin = csin_ml;
399658da7f69SStefano Zampini     redist = PETSC_FALSE;
39976e683305SStefano Zampini   } else {
39986e683305SStefano Zampini     ncoarse = ncoarse_ds;
39996e683305SStefano Zampini     csin = csin_ds;
40006e683305SStefano Zampini   }
4001e7931f94SStefano Zampini 
4002abbbba34SStefano Zampini   /* creates temporary l2gmap and IS for coarse indexes */
4003abbbba34SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
4004abbbba34SStefano Zampini   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
4005abbbba34SStefano Zampini 
4006abbbba34SStefano Zampini   /* creates temporary MATIS object for coarse matrix */
400722bc73bbSStefano Zampini   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
400822bc73bbSStefano Zampini   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
400922bc73bbSStefano Zampini   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
401022bc73bbSStefano Zampini   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
4011b9b85e73SStefano Zampini #if 0
4012b9b85e73SStefano Zampini   {
4013b9b85e73SStefano Zampini     PetscViewer viewer;
4014b9b85e73SStefano Zampini     char filename[256];
4015b9b85e73SStefano Zampini     sprintf(filename,"local_coarse_mat%d.m",PetscGlobalRank);
4016b9b85e73SStefano Zampini     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4017b9b85e73SStefano Zampini     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4018b9b85e73SStefano Zampini     ierr = MatView(coarse_submat_dense,viewer);CHKERRQ(ierr);
4019b9b85e73SStefano Zampini     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4020b9b85e73SStefano Zampini   }
4021b9b85e73SStefano Zampini #endif
40226e683305SStefano 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);
40236e683305SStefano Zampini   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
40246e683305SStefano Zampini   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
40256e683305SStefano Zampini   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
4026abbbba34SStefano Zampini   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
4027abbbba34SStefano Zampini 
40286e683305SStefano Zampini   /* compute dofs splitting and neumann boundaries for coarse dofs */
40296e683305SStefano Zampini   if (multilevel_allowed && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal) ) { /* protects from unneded computations */
40306e683305SStefano Zampini     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
40316e683305SStefano Zampini     const PetscInt         *idxs;
40326e683305SStefano Zampini     ISLocalToGlobalMapping tmap;
40336e683305SStefano Zampini 
40346e683305SStefano Zampini     /* create map between primal indices (in local representative ordering) and local primal numbering */
40350be93d54SStefano Zampini     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
40366e683305SStefano Zampini     /* allocate space for temporary storage */
4037854ce69bSBarry Smith     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
4038854ce69bSBarry Smith     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
40396e683305SStefano Zampini     /* allocate for IS array */
40406e683305SStefano Zampini     nisdofs = pcbddc->n_ISForDofsLocal;
40416e683305SStefano Zampini     nisneu = !!pcbddc->NeumannBoundariesLocal;
40426e683305SStefano Zampini     nis = nisdofs + nisneu;
4043854ce69bSBarry Smith     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
40446e683305SStefano Zampini     /* dofs splitting */
40456e683305SStefano Zampini     for (i=0;i<nisdofs;i++) {
40466e683305SStefano Zampini       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
40476e683305SStefano Zampini       ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
40486e683305SStefano Zampini       ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
40496e683305SStefano Zampini       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
40506e683305SStefano Zampini       ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
40516e683305SStefano Zampini       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
40526e683305SStefano Zampini       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pcbddc->ISForDofsLocal[i]),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
40536e683305SStefano Zampini       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
40546e683305SStefano Zampini     }
40556e683305SStefano Zampini     /* neumann boundaries */
40566e683305SStefano Zampini     if (pcbddc->NeumannBoundariesLocal) {
40576e683305SStefano Zampini       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
40586e683305SStefano Zampini       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
40596e683305SStefano Zampini       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
40606e683305SStefano Zampini       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
40616e683305SStefano Zampini       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
40626e683305SStefano Zampini       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
40636e683305SStefano Zampini       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pcbddc->NeumannBoundariesLocal),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
40646e683305SStefano Zampini       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
40656e683305SStefano Zampini     }
40666e683305SStefano Zampini     /* free memory */
40676e683305SStefano Zampini     ierr = PetscFree(tidxs);CHKERRQ(ierr);
40686e683305SStefano Zampini     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
40696e683305SStefano Zampini     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
40706e683305SStefano Zampini   } else {
40716e683305SStefano Zampini     nis = 0;
40726e683305SStefano Zampini     nisdofs = 0;
40736e683305SStefano Zampini     nisneu = 0;
40746e683305SStefano Zampini     isarray = NULL;
40756e683305SStefano Zampini   }
40766e683305SStefano Zampini   /* destroy no longer needed map */
40776e683305SStefano Zampini   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
40786e683305SStefano Zampini 
40796e683305SStefano Zampini   /* restrict on coarse candidates (if needed) */
40806e683305SStefano Zampini   coarse_mat_is = NULL;
40816e683305SStefano Zampini   if (csin) {
40826e683305SStefano Zampini     if (!pcbddc->coarse_subassembling_init ) { /* creates subassembling init pattern if not present */
408374e2c79eSStefano Zampini       if (redist) {
408474e2c79eSStefano Zampini         PetscMPIInt rank;
4085779c1cceSStefano Zampini         PetscInt    spc,n_spc_p1,dest[1],destsize;
408674e2c79eSStefano Zampini 
408774e2c79eSStefano Zampini         ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
408858da7f69SStefano Zampini         spc = active_procs/ncoarse;
408958da7f69SStefano Zampini         n_spc_p1 = active_procs%ncoarse;
4090779c1cceSStefano Zampini         if (im_active) {
4091779c1cceSStefano Zampini           destsize = 1;
409274e2c79eSStefano Zampini           if (rank > n_spc_p1*(spc+1)-1) {
409374e2c79eSStefano Zampini             dest[0] = n_spc_p1+(rank-(n_spc_p1*(spc+1)))/spc;
409474e2c79eSStefano Zampini           } else {
409574e2c79eSStefano Zampini             dest[0] = rank/(spc+1);
409674e2c79eSStefano Zampini           }
409774e2c79eSStefano Zampini         } else {
4098779c1cceSStefano Zampini           destsize = 0;
40996e683305SStefano Zampini         }
4100779c1cceSStefano Zampini         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),destsize,dest,PETSC_COPY_VALUES,&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
4101779c1cceSStefano Zampini       } else if (csin_type_simple) {
41026e683305SStefano Zampini         PetscMPIInt rank;
41036e683305SStefano Zampini         PetscInt    issize,isidx;
4104779c1cceSStefano Zampini 
41056e683305SStefano Zampini         ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
41066e683305SStefano Zampini         if (im_active) {
41076e683305SStefano Zampini           issize = 1;
41086e683305SStefano Zampini           isidx = (PetscInt)rank;
41096e683305SStefano Zampini         } else {
41106e683305SStefano Zampini           issize = 0;
41116e683305SStefano Zampini           isidx = -1;
41126e683305SStefano Zampini         }
41136e683305SStefano Zampini         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),issize,&isidx,PETSC_COPY_VALUES,&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
4114779c1cceSStefano Zampini       } else { /* get a suitable subassembling pattern from MATIS code */
41156e683305SStefano Zampini         ierr = MatISGetSubassemblingPattern(t_coarse_mat_is,ncoarse,PETSC_TRUE,&pcbddc->coarse_subassembling_init);CHKERRQ(ierr);
41166e683305SStefano Zampini       }
4117779c1cceSStefano Zampini 
4118779c1cceSStefano Zampini       /* we need to shift on coarse candidates either if we are not redistributing or we are redistributing and we have enough void processes */
4119779c1cceSStefano Zampini       if (!redist || ncoarse <= void_procs) {
4120779c1cceSStefano Zampini         PetscInt ncoarse_cand,tissize,*nisindices;
4121779c1cceSStefano Zampini         PetscInt *coarse_candidates;
4122779c1cceSStefano Zampini         const PetscInt* tisindices;
4123779c1cceSStefano Zampini 
4124779c1cceSStefano Zampini         /* get coarse candidates' ranks in pc communicator */
4125779c1cceSStefano Zampini         ierr = PetscMalloc1(all_procs,&coarse_candidates);CHKERRQ(ierr);
4126779c1cceSStefano Zampini         ierr = MPI_Allgather(&im_active,1,MPIU_INT,coarse_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4127779c1cceSStefano Zampini         for (i=0,ncoarse_cand=0;i<all_procs;i++) {
4128779c1cceSStefano Zampini           if (!coarse_candidates[i]) {
4129779c1cceSStefano Zampini             coarse_candidates[ncoarse_cand++]=i;
4130779c1cceSStefano Zampini           }
4131779c1cceSStefano Zampini         }
4132779c1cceSStefano Zampini         if (ncoarse_cand < ncoarse) SETERRQ2(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen! %d < %d",ncoarse_cand,ncoarse);
4133779c1cceSStefano Zampini 
4134779c1cceSStefano Zampini 
41356e683305SStefano Zampini         if (pcbddc->dbg_flag) {
41366e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
41376e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Subassembling pattern init (before shift)\n");CHKERRQ(ierr);
41386e683305SStefano Zampini           ierr = ISView(pcbddc->coarse_subassembling_init,pcbddc->dbg_viewer);CHKERRQ(ierr);
41396e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse candidates\n");CHKERRQ(ierr);
4140779c1cceSStefano Zampini           for (i=0;i<ncoarse_cand;i++) {
41416e683305SStefano Zampini             ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"%d ",coarse_candidates[i]);CHKERRQ(ierr);
41426e683305SStefano Zampini           }
41436e683305SStefano Zampini           ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"\n");CHKERRQ(ierr);
41446e683305SStefano Zampini           ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
41456e683305SStefano Zampini         }
41466e683305SStefano Zampini         /* shift the pattern on coarse candidates */
41476e683305SStefano Zampini         ierr = ISGetLocalSize(pcbddc->coarse_subassembling_init,&tissize);CHKERRQ(ierr);
41486e683305SStefano Zampini         ierr = ISGetIndices(pcbddc->coarse_subassembling_init,&tisindices);CHKERRQ(ierr);
4149854ce69bSBarry Smith         ierr = PetscMalloc1(tissize,&nisindices);CHKERRQ(ierr);
41506e683305SStefano Zampini         for (i=0;i<tissize;i++) nisindices[i] = coarse_candidates[tisindices[i]];
41516e683305SStefano Zampini         ierr = ISRestoreIndices(pcbddc->coarse_subassembling_init,&tisindices);CHKERRQ(ierr);
41526e683305SStefano Zampini         ierr = ISGeneralSetIndices(pcbddc->coarse_subassembling_init,tissize,nisindices,PETSC_OWN_POINTER);CHKERRQ(ierr);
41536e683305SStefano Zampini         ierr = PetscFree(coarse_candidates);CHKERRQ(ierr);
41546e683305SStefano Zampini       }
41556e683305SStefano Zampini       if (pcbddc->dbg_flag) {
41566e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
41576e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Subassembling pattern init\n");CHKERRQ(ierr);
41586e683305SStefano Zampini         ierr = ISView(pcbddc->coarse_subassembling_init,pcbddc->dbg_viewer);CHKERRQ(ierr);
41596e683305SStefano Zampini         ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
41606e683305SStefano Zampini       }
4161779c1cceSStefano Zampini     }
41626e683305SStefano Zampini     /* get temporary coarse mat in IS format restricted on coarse procs (plus additional index sets of isarray) */
41636e683305SStefano Zampini     ierr = MatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling_init,0,PETSC_TRUE,MAT_INITIAL_MATRIX,&coarse_mat_is,nis,isarray);CHKERRQ(ierr);
41646e683305SStefano Zampini   } else {
41656e683305SStefano Zampini     if (pcbddc->dbg_flag) {
41666e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
41676e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Subassembling pattern init not needed\n");CHKERRQ(ierr);
41686e683305SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
41696e683305SStefano Zampini     }
41706e683305SStefano Zampini     ierr = PetscObjectReference((PetscObject)t_coarse_mat_is);CHKERRQ(ierr);
41716e683305SStefano Zampini     coarse_mat_is = t_coarse_mat_is;
41726e683305SStefano Zampini   }
41736e683305SStefano Zampini 
41746e683305SStefano Zampini   /* create local to global scatters for coarse problem */
417568457ee5SStefano Zampini   if (compute_vecs) {
41766e683305SStefano Zampini     PetscInt lrows;
41776e683305SStefano Zampini     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
41786e683305SStefano Zampini     if (coarse_mat_is) {
41796e683305SStefano Zampini       ierr = MatGetLocalSize(coarse_mat_is,&lrows,NULL);CHKERRQ(ierr);
41806e683305SStefano Zampini     } else {
41816e683305SStefano Zampini       lrows = 0;
41826e683305SStefano Zampini     }
41836e683305SStefano Zampini     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
41846e683305SStefano Zampini     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
41856e683305SStefano Zampini     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
41866e683305SStefano Zampini     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
41876e683305SStefano Zampini     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
41886e683305SStefano Zampini   }
41896e683305SStefano Zampini   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
41906e683305SStefano Zampini   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
4191c8587f34SStefano Zampini 
4192f9eb5b7dSStefano Zampini   /* set defaults for coarse KSP and PC */
4193f9eb5b7dSStefano Zampini   if (multilevel_allowed) {
4194f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPRICHARDSON;
4195f9eb5b7dSStefano Zampini     coarse_pc_type = PCBDDC;
4196f9eb5b7dSStefano Zampini   } else {
4197f9eb5b7dSStefano Zampini     coarse_ksp_type = KSPPREONLY;
4198f9eb5b7dSStefano Zampini     coarse_pc_type = PCREDUNDANT;
4199c8587f34SStefano Zampini   }
4200c8587f34SStefano Zampini 
42016e683305SStefano Zampini   /* print some info if requested */
42026e683305SStefano Zampini   if (pcbddc->dbg_flag) {
42036e683305SStefano Zampini     if (!multilevel_allowed) {
42046e683305SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
42056e683305SStefano Zampini       if (multilevel_requested) {
42066e683305SStefano 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);
42076e683305SStefano Zampini       } else if (pcbddc->max_levels) {
42086e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
42096e683305SStefano Zampini       }
42106e683305SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
42116e683305SStefano Zampini     }
42126e683305SStefano Zampini   }
42136e683305SStefano Zampini 
4214f9eb5b7dSStefano Zampini   /* create the coarse KSP object only once with defaults */
42156e683305SStefano Zampini   if (coarse_mat_is) {
42166e683305SStefano Zampini     MatReuse coarse_mat_reuse;
42176a1308c2SStefano Zampini     PetscViewer dbg_viewer = NULL;
42186e683305SStefano Zampini     if (pcbddc->dbg_flag) {
42196e683305SStefano Zampini       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat_is));
42206e683305SStefano Zampini       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
42216e683305SStefano Zampini     }
4222f9eb5b7dSStefano Zampini     if (!pcbddc->coarse_ksp) {
4223312be037SStefano Zampini       char prefix[256],str_level[16];
4224e604994aSStefano Zampini       size_t len;
42256e683305SStefano Zampini       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat_is),&pcbddc->coarse_ksp);CHKERRQ(ierr);
4226c8587f34SStefano Zampini       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
4227f9eb5b7dSStefano Zampini       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
42285f76c7aeSStefano Zampini       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat_is,coarse_mat_is);CHKERRQ(ierr);
4229c8587f34SStefano Zampini       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
42306e683305SStefano Zampini       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
4231c8587f34SStefano Zampini       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
4232c8587f34SStefano Zampini       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
4233e604994aSStefano Zampini       /* prefix */
4234e604994aSStefano Zampini       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
4235e604994aSStefano Zampini       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
4236e604994aSStefano Zampini       if (!pcbddc->current_level) {
4237e604994aSStefano Zampini         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4238e604994aSStefano Zampini         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
4239c8587f34SStefano Zampini       } else {
4240e604994aSStefano Zampini         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
4241312be037SStefano Zampini         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
4242312be037SStefano Zampini         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
424334d6797cSStefano Zampini         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4244312be037SStefano Zampini         sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
4245e604994aSStefano Zampini         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
4246e604994aSStefano Zampini       }
4247e604994aSStefano Zampini       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
4248f9eb5b7dSStefano Zampini       /* allow user customization */
4249f9eb5b7dSStefano Zampini       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
42507e0def11SStefano Zampini       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4251312be037SStefano Zampini     }
4252f9eb5b7dSStefano Zampini 
4253f9eb5b7dSStefano Zampini     /* get some info after set from options */
4254f9eb5b7dSStefano Zampini     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
4255f9eb5b7dSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
4256f9eb5b7dSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
42574f3a063dSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
42586e683305SStefano Zampini     if (isbddc && !multilevel_allowed) { /* multilevel can only be requested via pc_bddc_set_levels */
4259f9eb5b7dSStefano Zampini       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
4260f9eb5b7dSStefano Zampini       isbddc = PETSC_FALSE;
4261f9eb5b7dSStefano Zampini     }
42624f3a063dSStefano Zampini     if (isredundant) {
42634f3a063dSStefano Zampini       KSP inner_ksp;
42644f3a063dSStefano Zampini       PC inner_pc;
42654f3a063dSStefano Zampini       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
42664f3a063dSStefano Zampini       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
42674f3a063dSStefano Zampini       ierr = PCFactorSetReuseFill(inner_pc,PETSC_TRUE);CHKERRQ(ierr);
42684f3a063dSStefano Zampini     }
4269f9eb5b7dSStefano Zampini 
42706e683305SStefano Zampini     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
4271f9eb5b7dSStefano Zampini     ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
4272f9eb5b7dSStefano Zampini     ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
4273f9eb5b7dSStefano Zampini     ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
42746e683305SStefano Zampini     if (nisdofs) {
42756e683305SStefano Zampini       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
42766e683305SStefano Zampini       for (i=0;i<nisdofs;i++) {
42776e683305SStefano Zampini         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
42781035eff8SStefano Zampini       }
42791035eff8SStefano Zampini     }
42806e683305SStefano Zampini     if (nisneu) {
42816e683305SStefano Zampini       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
42826e683305SStefano Zampini       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
42831035eff8SStefano Zampini     }
4284fdc09c96SStefano Zampini 
4285f9eb5b7dSStefano Zampini     /* assemble coarse matrix */
4286fa7f1dd8SStefano Zampini     if (coarse_reuse) {
428781d9aea3SBarry Smith       ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
4288fa7f1dd8SStefano Zampini       ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
42896e683305SStefano Zampini       coarse_mat_reuse = MAT_REUSE_MATRIX;
4290fa7f1dd8SStefano Zampini     } else {
42916e683305SStefano Zampini       coarse_mat_reuse = MAT_INITIAL_MATRIX;
4292fa7f1dd8SStefano Zampini     }
4293c8587f34SStefano Zampini     if (isbddc || isnn) {
429422bc73bbSStefano Zampini       if (pcbddc->coarsening_ratio > 1) {
429570cf5478SStefano Zampini         if (!pcbddc->coarse_subassembling) { /* subassembling info is not present */
429628143c3dSStefano Zampini           ierr = MatISGetSubassemblingPattern(coarse_mat_is,active_procs/pcbddc->coarsening_ratio,PETSC_TRUE,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
429722b6e8a2SStefano Zampini           if (pcbddc->dbg_flag) {
42986e683305SStefano Zampini             ierr = PetscViewerASCIIPrintf(dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
42996e683305SStefano Zampini             ierr = PetscViewerASCIIPrintf(dbg_viewer,"Subassembling pattern\n");CHKERRQ(ierr);
43006e683305SStefano Zampini             ierr = ISView(pcbddc->coarse_subassembling,dbg_viewer);CHKERRQ(ierr);
43016e683305SStefano Zampini             ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
430222b6e8a2SStefano Zampini           }
430370cf5478SStefano Zampini         }
43046e683305SStefano Zampini         ierr = MatISSubassemble(coarse_mat_is,pcbddc->coarse_subassembling,0,PETSC_FALSE,coarse_mat_reuse,&coarse_mat,0,NULL);CHKERRQ(ierr);
430570cf5478SStefano Zampini       } else {
430622bc73bbSStefano Zampini         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
430722bc73bbSStefano Zampini         coarse_mat = coarse_mat_is;
430822bc73bbSStefano Zampini       }
430922bc73bbSStefano Zampini     } else {
43102e1e5fa4SStefano Zampini       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
4311c8587f34SStefano Zampini     }
4312c8587f34SStefano Zampini     ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
4313c8587f34SStefano Zampini 
4314c8587f34SStefano Zampini     /* propagate symmetry info to coarse matrix */
4315b9d89cd5SStefano Zampini     ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pcbddc->issym);CHKERRQ(ierr);
43165a16e3a0SStefano Zampini     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
4317c8587f34SStefano Zampini 
43186e683305SStefano Zampini     /* set operators */
43195f76c7aeSStefano Zampini     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
43206e683305SStefano Zampini     if (pcbddc->dbg_flag) {
43216e683305SStefano Zampini       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
43226e683305SStefano Zampini     }
43236e683305SStefano Zampini   } else { /* processes non partecipating to coarse solver (if any) */
43246e683305SStefano Zampini     coarse_mat = 0;
43256e683305SStefano Zampini   }
43266e683305SStefano Zampini   ierr = PetscFree(isarray);CHKERRQ(ierr);
4327b9b85e73SStefano Zampini #if 0
4328b9b85e73SStefano Zampini   {
4329b9b85e73SStefano Zampini     PetscViewer viewer;
4330b9b85e73SStefano Zampini     char filename[256];
4331b9b85e73SStefano Zampini     sprintf(filename,"coarse_mat.m");
4332b9b85e73SStefano Zampini     ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,filename,&viewer);CHKERRQ(ierr);
4333b9b85e73SStefano Zampini     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4334b9b85e73SStefano Zampini     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
4335b9b85e73SStefano Zampini     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4336b9b85e73SStefano Zampini   }
4337b9b85e73SStefano Zampini #endif
4338c8587f34SStefano Zampini 
4339c8587f34SStefano Zampini   /* Compute coarse null space (special handling by BDDC only) */
4340c8587f34SStefano Zampini   if (pcbddc->NullSpace) {
4341c8587f34SStefano Zampini     ierr = PCBDDCNullSpaceAssembleCoarse(pc,coarse_mat,&CoarseNullSpace);CHKERRQ(ierr);
434298a51de6SStefano Zampini   }
434398a51de6SStefano Zampini 
434498a51de6SStefano Zampini   if (pcbddc->coarse_ksp) {
434598a51de6SStefano Zampini     Vec crhs,csol;
434698a51de6SStefano Zampini     PetscBool ispreonly;
434798a51de6SStefano Zampini     if (CoarseNullSpace) {
4348c8587f34SStefano Zampini       if (isbddc) {
4349c8587f34SStefano Zampini         ierr = PCBDDCSetNullSpace(pc_temp,CoarseNullSpace);CHKERRQ(ierr);
4350c8587f34SStefano Zampini       } else {
4351c8587f34SStefano Zampini         ierr = KSPSetNullSpace(pcbddc->coarse_ksp,CoarseNullSpace);CHKERRQ(ierr);
4352c8587f34SStefano Zampini       }
4353c8587f34SStefano Zampini     }
4354f9eb5b7dSStefano Zampini     /* setup coarse ksp */
4355f9eb5b7dSStefano Zampini     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
4356f347579bSStefano Zampini     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
4357f347579bSStefano Zampini     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
43586e683305SStefano Zampini     /* hack */
4359f347579bSStefano Zampini     if (!csol) {
43602a7a6963SBarry Smith       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
4361f9eb5b7dSStefano Zampini     }
4362f347579bSStefano Zampini     if (!crhs) {
43632a7a6963SBarry Smith       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
4364f347579bSStefano Zampini     }
4365cbcc2c2aSStefano Zampini     /* Check coarse problem if in debug mode or if solving with an iterative method */
4366cbcc2c2aSStefano Zampini     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
43676e683305SStefano Zampini     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
4368c8587f34SStefano Zampini       KSP       check_ksp;
43692b510759SStefano Zampini       KSPType   check_ksp_type;
4370c8587f34SStefano Zampini       PC        check_pc;
43716e683305SStefano Zampini       Vec       check_vec,coarse_vec;
43726a1308c2SStefano Zampini       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
43732b510759SStefano Zampini       PetscInt  its;
43746e683305SStefano Zampini       PetscBool compute_eigs;
43756e683305SStefano Zampini       PetscReal *eigs_r,*eigs_c;
43766e683305SStefano Zampini       PetscInt  neigs;
43778e185a42SStefano Zampini       const char *prefix;
4378c8587f34SStefano Zampini 
43792b510759SStefano Zampini       /* Create ksp object suitable for estimation of extreme eigenvalues */
43806e683305SStefano Zampini       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
438123ee1639SBarry Smith       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
4382f4ddd8eeSStefano Zampini       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
43832b510759SStefano Zampini       if (ispreonly) {
43842b510759SStefano Zampini         check_ksp_type = KSPPREONLY;
43856e683305SStefano Zampini         compute_eigs = PETSC_FALSE;
43862b510759SStefano Zampini       } else {
4387cbcc2c2aSStefano Zampini         check_ksp_type = KSPGMRES;
43886e683305SStefano Zampini         compute_eigs = PETSC_TRUE;
4389c8587f34SStefano Zampini       }
4390c8587f34SStefano Zampini       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
43916e683305SStefano Zampini       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
43926e683305SStefano Zampini       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
43936e683305SStefano Zampini       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
4394a7dc3881SStefano Zampini       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
4395a7dc3881SStefano Zampini       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
4396a7dc3881SStefano Zampini       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
4397a7dc3881SStefano Zampini       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
4398c8587f34SStefano Zampini       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
4399c8587f34SStefano Zampini       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
4400c8587f34SStefano Zampini       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
4401c8587f34SStefano Zampini       /* create random vec */
44026e683305SStefano Zampini       ierr = KSPGetSolution(pcbddc->coarse_ksp,&coarse_vec);CHKERRQ(ierr);
44036e683305SStefano Zampini       ierr = VecDuplicate(coarse_vec,&check_vec);CHKERRQ(ierr);
4404c8587f34SStefano Zampini       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
4405c8587f34SStefano Zampini       if (CoarseNullSpace) {
4406c8587f34SStefano Zampini         ierr = MatNullSpaceRemove(CoarseNullSpace,check_vec);CHKERRQ(ierr);
4407c8587f34SStefano Zampini       }
44086e683305SStefano Zampini       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
4409c8587f34SStefano Zampini       /* solve coarse problem */
44106e683305SStefano Zampini       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
4411c8587f34SStefano Zampini       if (CoarseNullSpace) {
44126e683305SStefano Zampini         ierr = MatNullSpaceRemove(CoarseNullSpace,coarse_vec);CHKERRQ(ierr);
4413c8587f34SStefano Zampini       }
4414cbcc2c2aSStefano Zampini       /* set eigenvalue estimation if preonly has not been requested */
44156e683305SStefano Zampini       if (compute_eigs) {
4416854ce69bSBarry Smith         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
4417854ce69bSBarry Smith         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
44186e683305SStefano Zampini         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
44196e683305SStefano Zampini         lambda_max = eigs_r[neigs-1];
44206e683305SStefano Zampini         lambda_min = eigs_r[0];
44216e683305SStefano Zampini         if (pcbddc->use_coarse_estimates) {
44226e683305SStefano Zampini           if (lambda_max>lambda_min) {
4423cbcc2c2aSStefano Zampini             ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max,lambda_min);CHKERRQ(ierr);
4424cbcc2c2aSStefano Zampini             ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
4425cbcc2c2aSStefano Zampini           }
4426c8587f34SStefano Zampini         }
4427c8587f34SStefano Zampini       }
4428cbcc2c2aSStefano Zampini 
4429c8587f34SStefano Zampini       /* check coarse problem residual error */
44306e683305SStefano Zampini       if (pcbddc->dbg_flag) {
44316e683305SStefano Zampini         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
44326e683305SStefano Zampini         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
44336e683305SStefano Zampini         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
4434c8587f34SStefano Zampini         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
44356e683305SStefano Zampini         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
44366e683305SStefano Zampini         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
4437c8587f34SStefano Zampini         ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
4438779c1cceSStefano Zampini         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
44396e683305SStefano Zampini         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
44406e683305SStefano Zampini         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
44416e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
44426e683305SStefano Zampini         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
44436e683305SStefano Zampini         if (compute_eigs) {
44446e683305SStefano Zampini           PetscReal lambda_max_s,lambda_min_s;
4445deec49d1SStefano Zampini           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
4446c8587f34SStefano Zampini           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
44476e683305SStefano Zampini           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
44486e683305SStefano 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);
44496e683305SStefano Zampini           for (i=0;i<neigs;i++) {
44506e683305SStefano Zampini             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
4451c8587f34SStefano Zampini           }
44526e683305SStefano Zampini         }
44536e683305SStefano Zampini         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
44546e683305SStefano Zampini         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
44556e683305SStefano Zampini       }
4456c8587f34SStefano Zampini       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
44576e683305SStefano Zampini       if (compute_eigs) {
44586e683305SStefano Zampini         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
44596e683305SStefano Zampini         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
4460c8587f34SStefano Zampini       }
44616e683305SStefano Zampini     }
44626e683305SStefano Zampini   }
4463cbcc2c2aSStefano Zampini   /* print additional info */
4464cbcc2c2aSStefano Zampini   if (pcbddc->dbg_flag) {
44656e683305SStefano Zampini     /* waits until all processes reaches this point */
44666e683305SStefano Zampini     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
4467cbcc2c2aSStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
4468cbcc2c2aSStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4469cbcc2c2aSStefano Zampini   }
4470cbcc2c2aSStefano Zampini 
44712b510759SStefano Zampini   /* free memory */
4472c8587f34SStefano Zampini   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
4473fdc635d7SStefano Zampini   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
4474c8587f34SStefano Zampini   PetscFunctionReturn(0);
4475c8587f34SStefano Zampini }
4476674ae819SStefano Zampini 
4477f34684f1SStefano Zampini #undef __FUNCT__
4478f34684f1SStefano Zampini #define __FUNCT__ "PCBDDCComputePrimalNumbering"
4479f34684f1SStefano Zampini PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
4480f34684f1SStefano Zampini {
4481f34684f1SStefano Zampini   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4482f34684f1SStefano Zampini   PC_IS*         pcis = (PC_IS*)pc->data;
4483f34684f1SStefano Zampini   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4484727cdba6SStefano Zampini   PetscInt       i,coarse_size;
4485727cdba6SStefano Zampini   PetscInt       *local_primal_indices;
4486f34684f1SStefano Zampini   PetscErrorCode ierr;
4487f34684f1SStefano Zampini 
4488f34684f1SStefano Zampini   PetscFunctionBegin;
4489f34684f1SStefano Zampini   /* Compute global number of coarse dofs */
449089c96988SStefano Zampini   if (!pcbddc->primal_indices_local_idxs && pcbddc->local_primal_size) {
449189c96988SStefano Zampini     SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Local primal indices have not been created");
4492727cdba6SStefano Zampini   }
4493727cdba6SStefano 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);
4494f34684f1SStefano Zampini 
4495f34684f1SStefano Zampini   /* check numbering */
4496f34684f1SStefano Zampini   if (pcbddc->dbg_flag) {
4497f34684f1SStefano Zampini     PetscScalar coarsesum,*array;
4498b9b85e73SStefano Zampini     PetscBool set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
4499f34684f1SStefano Zampini 
4500f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4501f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4502f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
45030fccc4e9SStefano Zampini     ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
4504f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
4505f34684f1SStefano Zampini     for (i=0;i<pcbddc->local_primal_size;i++) {
4506727cdba6SStefano Zampini       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
4507f34684f1SStefano Zampini     }
4508f34684f1SStefano Zampini     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
4509f34684f1SStefano Zampini     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
4510f34684f1SStefano Zampini     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
4511f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4512f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4513f34684f1SStefano Zampini     ierr = VecScatterBegin(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4514f34684f1SStefano Zampini     ierr = VecScatterEnd(matis->ctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4515f34684f1SStefano Zampini     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
4516f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
4517f34684f1SStefano Zampini       if (array[i] == 1.0) {
4518b9b85e73SStefano Zampini         set_error = PETSC_TRUE;
4519f34684f1SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d owned by a single process!\n",PetscGlobalRank,i);CHKERRQ(ierr);
4520f34684f1SStefano Zampini       }
4521f34684f1SStefano Zampini     }
4522b9b85e73SStefano Zampini     ierr = MPI_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4523f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4524f34684f1SStefano Zampini     for (i=0;i<pcis->n;i++) {
4525f34684f1SStefano Zampini       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
4526f34684f1SStefano Zampini     }
4527f34684f1SStefano Zampini     ierr = VecRestoreArray(pcis->vec1_N,&array);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 = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
4532f34684f1SStefano Zampini     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
4533b9b85e73SStefano Zampini     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
4534f34684f1SStefano Zampini       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
4535f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4536f34684f1SStefano Zampini       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
4537f34684f1SStefano Zampini       for (i=0;i<pcbddc->local_primal_size;i++) {
4538727cdba6SStefano Zampini         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_primal_indices[%d]=%d (%d)\n",i,local_primal_indices[i],pcbddc->primal_indices_local_idxs[i]);
4539f34684f1SStefano Zampini       }
4540f34684f1SStefano Zampini       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4541f34684f1SStefano Zampini     }
4542f34684f1SStefano Zampini     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4543b9b85e73SStefano Zampini     if (set_error_reduced) {
4544b9b85e73SStefano Zampini       SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
4545b9b85e73SStefano Zampini     }
4546f34684f1SStefano Zampini   }
4547f34684f1SStefano Zampini   /* get back data */
4548f34684f1SStefano Zampini   *coarse_size_n = coarse_size;
4549f34684f1SStefano Zampini   *local_primal_indices_n = local_primal_indices;
4550674ae819SStefano Zampini   PetscFunctionReturn(0);
4551674ae819SStefano Zampini }
4552674ae819SStefano Zampini 
4553e456f2a8SStefano Zampini #undef __FUNCT__
4554e456f2a8SStefano Zampini #define __FUNCT__ "PCBDDCGlobalToLocal"
4555a7dc3881SStefano Zampini PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
4556e456f2a8SStefano Zampini {
4557e456f2a8SStefano Zampini   IS             localis_t;
4558a7dc3881SStefano Zampini   PetscInt       i,lsize,*idxs,n;
4559e456f2a8SStefano Zampini   PetscScalar    *vals;
4560e456f2a8SStefano Zampini   PetscErrorCode ierr;
4561e456f2a8SStefano Zampini 
4562e456f2a8SStefano Zampini   PetscFunctionBegin;
4563a7dc3881SStefano Zampini   /* get indices in local ordering exploiting local to global map */
4564e456f2a8SStefano Zampini   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
4565854ce69bSBarry Smith   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
4566e456f2a8SStefano Zampini   for (i=0;i<lsize;i++) vals[i] = 1.0;
4567e456f2a8SStefano Zampini   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
4568a7dc3881SStefano Zampini   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
4569a7dc3881SStefano Zampini   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
45701035eff8SStefano Zampini   if (idxs) { /* multilevel guard */
4571a7dc3881SStefano Zampini     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
45721035eff8SStefano Zampini   }
4573a7dc3881SStefano Zampini   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
4574e456f2a8SStefano Zampini   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
4575e456f2a8SStefano Zampini   ierr = PetscFree(vals);CHKERRQ(ierr);
4576a7dc3881SStefano Zampini   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
4577a7dc3881SStefano Zampini   /* now compute set in local ordering */
4578a7dc3881SStefano Zampini   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4579a7dc3881SStefano Zampini   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4580a7dc3881SStefano Zampini   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
4581a7dc3881SStefano Zampini   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
4582a7dc3881SStefano Zampini   for (i=0,lsize=0;i<n;i++) {
4583ff92baa0SMatthew G. Knepley     if (PetscRealPart(vals[i]) > 0.5) {
4584e456f2a8SStefano Zampini       lsize++;
4585e456f2a8SStefano Zampini     }
4586e456f2a8SStefano Zampini   }
4587854ce69bSBarry Smith   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
4588a7dc3881SStefano Zampini   for (i=0,lsize=0;i<n;i++) {
4589ff92baa0SMatthew G. Knepley     if (PetscRealPart(vals[i]) > 0.5) {
4590e456f2a8SStefano Zampini       idxs[lsize++] = i;
4591e456f2a8SStefano Zampini     }
4592e456f2a8SStefano Zampini   }
4593a7dc3881SStefano Zampini   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
4594a7dc3881SStefano Zampini   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
4595e456f2a8SStefano Zampini   *localis = localis_t;
4596e456f2a8SStefano Zampini   PetscFunctionReturn(0);
4597e456f2a8SStefano Zampini }
4598906d46d4SStefano Zampini 
4599906d46d4SStefano Zampini /* the next two functions will be called in KSPMatMult if a change of basis has been requested */
4600906d46d4SStefano Zampini #undef __FUNCT__
4601906d46d4SStefano Zampini #define __FUNCT__ "PCBDDCMatMult_Private"
4602906d46d4SStefano Zampini static PetscErrorCode PCBDDCMatMult_Private(Mat A, Vec x, Vec y)
4603906d46d4SStefano Zampini {
4604906d46d4SStefano Zampini   PCBDDCChange_ctx change_ctx;
4605906d46d4SStefano Zampini   PetscErrorCode   ierr;
4606906d46d4SStefano Zampini 
4607906d46d4SStefano Zampini   PetscFunctionBegin;
4608906d46d4SStefano Zampini   ierr = MatShellGetContext(A,&change_ctx);CHKERRQ(ierr);
4609906d46d4SStefano Zampini   ierr = MatMult(change_ctx->global_change,x,change_ctx->work[0]);CHKERRQ(ierr);
4610906d46d4SStefano Zampini   ierr = MatMult(change_ctx->original_mat,change_ctx->work[0],change_ctx->work[1]);CHKERRQ(ierr);
4611906d46d4SStefano Zampini   ierr = MatMultTranspose(change_ctx->global_change,change_ctx->work[1],y);CHKERRQ(ierr);
4612906d46d4SStefano Zampini   PetscFunctionReturn(0);
4613906d46d4SStefano Zampini }
4614906d46d4SStefano Zampini 
4615906d46d4SStefano Zampini #undef __FUNCT__
4616906d46d4SStefano Zampini #define __FUNCT__ "PCBDDCMatMultTranspose_Private"
4617906d46d4SStefano Zampini static PetscErrorCode PCBDDCMatMultTranspose_Private(Mat A, Vec x, Vec y)
4618906d46d4SStefano Zampini {
4619906d46d4SStefano Zampini   PCBDDCChange_ctx change_ctx;
4620906d46d4SStefano Zampini   PetscErrorCode   ierr;
4621906d46d4SStefano Zampini 
4622906d46d4SStefano Zampini   PetscFunctionBegin;
4623906d46d4SStefano Zampini   ierr = MatShellGetContext(A,&change_ctx);CHKERRQ(ierr);
4624906d46d4SStefano Zampini   ierr = MatMult(change_ctx->global_change,x,change_ctx->work[0]);CHKERRQ(ierr);
4625906d46d4SStefano Zampini   ierr = MatMultTranspose(change_ctx->original_mat,change_ctx->work[0],change_ctx->work[1]);CHKERRQ(ierr);
4626906d46d4SStefano Zampini   ierr = MatMultTranspose(change_ctx->global_change,change_ctx->work[1],y);CHKERRQ(ierr);
4627906d46d4SStefano Zampini   PetscFunctionReturn(0);
4628906d46d4SStefano Zampini }
4629b96c3477SStefano Zampini 
4630b96c3477SStefano Zampini #undef __FUNCT__
4631b96c3477SStefano Zampini #define __FUNCT__ "PCBDDCSetUpSubSchurs"
463208122e43SStefano Zampini PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
4633b96c3477SStefano Zampini {
4634b96c3477SStefano Zampini   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
4635b96c3477SStefano Zampini   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
4636b96c3477SStefano Zampini   PetscInt            *used_xadj,*used_adjncy;
4637b96c3477SStefano Zampini   PetscBool           free_used_adj;
4638b96c3477SStefano Zampini   PetscErrorCode      ierr;
4639b96c3477SStefano Zampini 
4640b96c3477SStefano Zampini   PetscFunctionBegin;
4641b96c3477SStefano Zampini   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
4642b96c3477SStefano Zampini   free_used_adj = PETSC_FALSE;
464308122e43SStefano Zampini   if (pcbddc->sub_schurs_layers == -1) {
4644b96c3477SStefano Zampini     used_xadj = NULL;
4645b96c3477SStefano Zampini     used_adjncy = NULL;
4646b96c3477SStefano Zampini   } else {
464708122e43SStefano Zampini     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
464808122e43SStefano Zampini       used_xadj = pcbddc->mat_graph->xadj;
464908122e43SStefano Zampini       used_adjncy = pcbddc->mat_graph->adjncy;
465008122e43SStefano Zampini     } else if (pcbddc->computed_rowadj) {
4651b96c3477SStefano Zampini       used_xadj = pcbddc->mat_graph->xadj;
4652b96c3477SStefano Zampini       used_adjncy = pcbddc->mat_graph->adjncy;
4653b96c3477SStefano Zampini     } else {
46542fffb893SStefano Zampini       PetscBool      flg_row=PETSC_FALSE;
4655b96c3477SStefano Zampini       const PetscInt *xadj,*adjncy;
4656b96c3477SStefano Zampini       PetscInt       nvtxs;
4657b96c3477SStefano Zampini 
46582fffb893SStefano Zampini       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
46592fffb893SStefano Zampini       if (flg_row) {
4660b96c3477SStefano Zampini         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
4661b96c3477SStefano Zampini         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
4662b96c3477SStefano Zampini         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
4663b96c3477SStefano Zampini         free_used_adj = PETSC_TRUE;
46642fffb893SStefano Zampini       } else {
46652fffb893SStefano Zampini         pcbddc->sub_schurs_layers = -1;
46662fffb893SStefano Zampini         used_xadj = NULL;
46672fffb893SStefano Zampini         used_adjncy = NULL;
46682fffb893SStefano Zampini       }
46692fffb893SStefano Zampini       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4670b96c3477SStefano Zampini     }
4671b96c3477SStefano Zampini   }
46729552c7c7SStefano Zampini   ierr = PCBDDCSubSchursSetUp(sub_schurs,used_xadj,used_adjncy,pcbddc->sub_schurs_layers,pcbddc->adaptive_selection,pcbddc->use_deluxe_scaling,pcbddc->adaptive_invert_Stildas,pcbddc->use_edges,pcbddc->use_faces);CHKERRQ(ierr);
4673b96c3477SStefano Zampini 
4674b96c3477SStefano Zampini   /* free adjacency */
4675b96c3477SStefano Zampini   if (free_used_adj) {
4676b96c3477SStefano Zampini     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
4677b96c3477SStefano Zampini   }
4678b96c3477SStefano Zampini   PetscFunctionReturn(0);
4679b96c3477SStefano Zampini }
4680b96c3477SStefano Zampini 
4681b96c3477SStefano Zampini #undef __FUNCT__
4682b96c3477SStefano Zampini #define __FUNCT__ "PCBDDCInitSubSchurs"
468308122e43SStefano Zampini PetscErrorCode PCBDDCInitSubSchurs(PC pc)
4684b96c3477SStefano Zampini {
4685b96c3477SStefano Zampini   PC_IS               *pcis=(PC_IS*)pc->data;
4686b96c3477SStefano Zampini   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
4687b96c3477SStefano Zampini   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
4688b96c3477SStefano Zampini   PCBDDCGraph         graph;
4689b96c3477SStefano Zampini   Mat                 S_j;
4690b96c3477SStefano Zampini   PetscErrorCode      ierr;
4691b96c3477SStefano Zampini 
4692b96c3477SStefano Zampini   PetscFunctionBegin;
4693b96c3477SStefano Zampini   /* attach interface graph for determining subsets */
469408122e43SStefano Zampini   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
4695b96c3477SStefano Zampini     IS verticesIS;
4696b96c3477SStefano Zampini 
4697b96c3477SStefano Zampini     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
4698b96c3477SStefano Zampini     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
4699b96c3477SStefano Zampini     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap);CHKERRQ(ierr);
4700b96c3477SStefano Zampini     ierr = PCBDDCGraphSetUp(graph,0,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticesIS);CHKERRQ(ierr);
4701b96c3477SStefano Zampini     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
4702b96c3477SStefano Zampini     ierr = ISDestroy(&verticesIS);CHKERRQ(ierr);
4703b96c3477SStefano Zampini /*
4704b96c3477SStefano Zampini     if (pcbddc->dbg_flag) {
4705b96c3477SStefano Zampini       ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
4706b96c3477SStefano Zampini     }
4707b96c3477SStefano Zampini */
4708b96c3477SStefano Zampini   } else {
4709b96c3477SStefano Zampini     graph = pcbddc->mat_graph;
4710b96c3477SStefano Zampini   }
4711b96c3477SStefano Zampini 
4712b96c3477SStefano Zampini   /* Create Schur complement matrix */
4713b96c3477SStefano Zampini   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
4714b96c3477SStefano Zampini   ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
4715b96c3477SStefano Zampini 
4716b96c3477SStefano Zampini   /* sub_schurs init */
471708122e43SStefano Zampini   ierr = PCBDDCSubSchursInit(sub_schurs,pcbddc->local_mat,S_j,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap,pcbddc->sub_schurs_threshold);CHKERRQ(ierr);
4718b96c3477SStefano Zampini   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
4719b96c3477SStefano Zampini   /* free graph struct */
472008122e43SStefano Zampini   if (pcbddc->sub_schurs_rebuild) {
4721b96c3477SStefano Zampini     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
4722b96c3477SStefano Zampini   }
4723b96c3477SStefano Zampini   PetscFunctionReturn(0);
4724b96c3477SStefano Zampini }
4725