1 #include <../src/ksp/pc/impls/bddc/bddc.h> 2 #include <../src/ksp/pc/impls/bddc/bddcprivate.h> 3 4 /* prototypes for deluxe functions */ 5 static PetscErrorCode PCBDDCScalingCreate_Deluxe(PC); 6 static PetscErrorCode PCBDDCScalingDestroy_Deluxe(PC); 7 static PetscErrorCode PCBDDCScalingSetUp_Deluxe(PC); 8 static PetscErrorCode PCBDDCScalingSetUp_Deluxe_Par(PC,PetscInt,PetscInt,PetscInt[],PetscInt[]); 9 static PetscErrorCode PCBDDCScalingSetUp_Deluxe_Seq(PC,PetscInt,PetscInt,PetscInt[],PetscInt[]); 10 static PetscErrorCode PCBDDCScalingReset_Deluxe_Solvers(PCBDDCDeluxeScaling); 11 12 #undef __FUNCT__ 13 #define __FUNCT__ "PCBDDCScalingExtension_Basic" 14 static PetscErrorCode PCBDDCScalingExtension_Basic(PC pc, Vec local_interface_vector, Vec global_vector) 15 { 16 PC_IS* pcis = (PC_IS*)pc->data; 17 PC_BDDC* pcbddc = (PC_BDDC*)pc->data; 18 PetscErrorCode ierr; 19 20 PetscFunctionBegin; 21 /* Apply partition of unity */ 22 ierr = VecPointwiseMult(pcbddc->work_scaling,pcis->D,local_interface_vector);CHKERRQ(ierr); 23 ierr = VecSet(global_vector,0.0);CHKERRQ(ierr); 24 ierr = VecScatterBegin(pcis->global_to_B,pcbddc->work_scaling,global_vector,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 25 ierr = VecScatterEnd(pcis->global_to_B,pcbddc->work_scaling,global_vector,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 26 PetscFunctionReturn(0); 27 } 28 29 #undef __FUNCT__ 30 #define __FUNCT__ "PCBDDCScalingExtension_Deluxe" 31 static PetscErrorCode PCBDDCScalingExtension_Deluxe(PC pc, Vec x, Vec y) 32 { 33 PC_IS* pcis=(PC_IS*)pc->data; 34 PC_BDDC* pcbddc=(PC_BDDC*)pc->data; 35 PCBDDCDeluxeScaling deluxe_ctx = pcbddc->deluxe_ctx; 36 PCBDDCSubSchurs sub_schurs = deluxe_ctx->sub_schurs; 37 PetscInt i; 38 PetscErrorCode ierr; 39 40 /* TODO CHECK STUFF RELATED WITH FAKE WORK */ 41 PetscFunctionBegin; 42 ierr = VecSet(pcbddc->work_scaling,0.0);CHKERRQ(ierr); /* needed by the fake work below */ 43 if (deluxe_ctx->n_simple) { 44 /* scale deluxe vertices using diagonal scaling */ 45 PetscScalar *array_x,*array_D,*array; 46 ierr = VecGetArray(x,&array_x);CHKERRQ(ierr); 47 ierr = VecGetArray(pcis->D,&array_D);CHKERRQ(ierr); 48 ierr = VecGetArray(pcbddc->work_scaling,&array);CHKERRQ(ierr); 49 for (i=0;i<deluxe_ctx->n_simple;i++) { 50 array[deluxe_ctx->idx_simple_B[i]] = array_x[deluxe_ctx->idx_simple_B[i]]*array_D[deluxe_ctx->idx_simple_B[i]]; 51 } 52 ierr = VecRestoreArray(pcbddc->work_scaling,&array);CHKERRQ(ierr); 53 ierr = VecRestoreArray(pcis->D,&array_D);CHKERRQ(ierr); 54 ierr = VecRestoreArray(x,&array_x);CHKERRQ(ierr); 55 } 56 /* sequential part : all problems and Schur applications collapsed into a single matrix vector multiplication and ksp solution */ 57 if (deluxe_ctx->seq_mat) { 58 ierr = VecScatterBegin(deluxe_ctx->seq_scctx,x,deluxe_ctx->seq_work1,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 59 ierr = VecScatterEnd(deluxe_ctx->seq_scctx,x,deluxe_ctx->seq_work1,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 60 ierr = MatMult(deluxe_ctx->seq_mat,deluxe_ctx->seq_work1,deluxe_ctx->seq_work2);CHKERRQ(ierr); 61 ierr = KSPSolve(deluxe_ctx->seq_ksp,deluxe_ctx->seq_work2,deluxe_ctx->seq_work1);CHKERRQ(ierr); 62 /* fake work due to final ADD VALUES and vertices scaling needed? TODO: check it */ 63 ierr = VecScatterBegin(deluxe_ctx->seq_scctx,deluxe_ctx->seq_work1,pcbddc->work_scaling,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 64 ierr = VecScatterEnd(deluxe_ctx->seq_scctx,deluxe_ctx->seq_work1,pcbddc->work_scaling,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 65 } 66 /* parallel part */ 67 for (i=0;i<deluxe_ctx->par_colors;i++) { 68 if (deluxe_ctx->par_ksp[i]) { 69 PetscMPIInt color_rank; 70 PetscInt subidx = deluxe_ctx->par_col2sub[i]; 71 /* restrict on subset */ 72 ierr = VecScatterBegin(deluxe_ctx->par_scctx_s[i],x,sub_schurs->work1[subidx],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 73 ierr = VecScatterEnd(deluxe_ctx->par_scctx_s[i],x,sub_schurs->work1[subidx],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 74 /* S_Ej */ 75 ierr = MatMult(sub_schurs->S_Ej[subidx],sub_schurs->work1[subidx],sub_schurs->work2[subidx]);CHKERRQ(ierr); 76 /* (\sum_j S_Ej)^-1 */ 77 ierr = VecSet(deluxe_ctx->par_vec[i],0.0);CHKERRQ(ierr); 78 ierr = VecScatterBegin(deluxe_ctx->par_scctx_p[i],sub_schurs->work2[subidx],deluxe_ctx->par_vec[i],ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 79 ierr = VecScatterEnd(deluxe_ctx->par_scctx_p[i],sub_schurs->work2[subidx],deluxe_ctx->par_vec[i],ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 80 ierr = KSPSolve(deluxe_ctx->par_ksp[i],deluxe_ctx->par_vec[i],deluxe_ctx->par_vec[i]);CHKERRQ(ierr); 81 ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)deluxe_ctx->par_ksp[i]),&color_rank);CHKERRQ(ierr); 82 /* get back solution on subset */ 83 ierr = VecScatterBegin(deluxe_ctx->par_scctx_p[i],deluxe_ctx->par_vec[i],sub_schurs->work1[subidx],INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 84 ierr = VecScatterEnd(deluxe_ctx->par_scctx_p[i],deluxe_ctx->par_vec[i],sub_schurs->work1[subidx],INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 85 if (!color_rank) { /* only the master process in coloured comm copies the computed values */ 86 ierr = VecScatterBegin(deluxe_ctx->par_scctx_s[i],sub_schurs->work1[subidx],pcbddc->work_scaling,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 87 ierr = VecScatterEnd(deluxe_ctx->par_scctx_s[i],sub_schurs->work1[subidx],pcbddc->work_scaling,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 88 } 89 } 90 } 91 /* put local boundary part in global vector */ 92 ierr = VecSet(y,0.0);CHKERRQ(ierr); 93 ierr = VecScatterBegin(pcis->global_to_B,pcbddc->work_scaling,y,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 94 ierr = VecScatterEnd(pcis->global_to_B,pcbddc->work_scaling,y,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 95 PetscFunctionReturn(0); 96 } 97 98 #undef __FUNCT__ 99 #define __FUNCT__ "PCBDDCScalingExtension" 100 PetscErrorCode PCBDDCScalingExtension(PC pc, Vec local_interface_vector, Vec global_vector) 101 { 102 PC_BDDC *pcbddc=(PC_BDDC*)pc->data; 103 PetscErrorCode ierr; 104 105 PetscFunctionBegin; 106 PetscValidHeaderSpecific(pc,PC_CLASSID,1); 107 PetscValidHeaderSpecific(local_interface_vector,VEC_CLASSID,2); 108 PetscValidHeaderSpecific(global_vector,VEC_CLASSID,3); 109 if (local_interface_vector == pcbddc->work_scaling) { 110 SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Local vector cannot be pcbddc->work_scaling!\n"); 111 } 112 ierr = PetscTryMethod(pc,"PCBDDCScalingExtension_C",(PC,Vec,Vec),(pc,local_interface_vector,global_vector));CHKERRQ(ierr); 113 PetscFunctionReturn(0); 114 } 115 116 #undef __FUNCT__ 117 #define __FUNCT__ "PCBDDCScalingRestriction_Basic" 118 static PetscErrorCode PCBDDCScalingRestriction_Basic(PC pc, Vec global_vector, Vec local_interface_vector) 119 { 120 PetscErrorCode ierr; 121 PC_IS* pcis = (PC_IS*)pc->data; 122 123 PetscFunctionBegin; 124 ierr = VecScatterBegin(pcis->global_to_B,global_vector,local_interface_vector,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 125 ierr = VecScatterEnd(pcis->global_to_B,global_vector,local_interface_vector,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 126 /* Apply partition of unity */ 127 ierr = VecPointwiseMult(local_interface_vector,pcis->D,local_interface_vector);CHKERRQ(ierr); 128 PetscFunctionReturn(0); 129 } 130 131 #undef __FUNCT__ 132 #define __FUNCT__ "PCBDDCScalingRestriction_Deluxe" 133 static PetscErrorCode PCBDDCScalingRestriction_Deluxe(PC pc, Vec x, Vec y) 134 { 135 PC_IS* pcis=(PC_IS*)pc->data; 136 PC_BDDC* pcbddc=(PC_BDDC*)pc->data; 137 PCBDDCDeluxeScaling deluxe_ctx = pcbddc->deluxe_ctx; 138 PCBDDCSubSchurs sub_schurs = deluxe_ctx->sub_schurs; 139 PetscInt i; 140 PetscErrorCode ierr; 141 142 PetscFunctionBegin; 143 /* get local boundary part of global vector */ 144 ierr = VecScatterBegin(pcis->global_to_B,x,y,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 145 ierr = VecScatterEnd(pcis->global_to_B,x,y,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 146 if (deluxe_ctx->n_simple) { 147 /* scale deluxe vertices using diagonal scaling */ 148 PetscScalar *array_y,*array_D; 149 ierr = VecGetArray(y,&array_y);CHKERRQ(ierr); 150 ierr = VecGetArray(pcis->D,&array_D);CHKERRQ(ierr); 151 for (i=0;i<deluxe_ctx->n_simple;i++) { 152 array_y[deluxe_ctx->idx_simple_B[i]] *= array_D[deluxe_ctx->idx_simple_B[i]]; 153 } 154 ierr = VecRestoreArray(pcis->D,&array_D);CHKERRQ(ierr); 155 ierr = VecRestoreArray(y,&array_y);CHKERRQ(ierr); 156 } 157 /* sequential part : all problems and Schur applications collapsed into a single matrix vector multiplication and ksp solution */ 158 if (deluxe_ctx->seq_mat) { 159 ierr = VecScatterBegin(deluxe_ctx->seq_scctx,y,deluxe_ctx->seq_work1,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 160 ierr = VecScatterEnd(deluxe_ctx->seq_scctx,y,deluxe_ctx->seq_work1,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 161 ierr = KSPSolveTranspose(deluxe_ctx->seq_ksp,deluxe_ctx->seq_work1,deluxe_ctx->seq_work2);CHKERRQ(ierr); 162 ierr = MatMultTranspose(deluxe_ctx->seq_mat,deluxe_ctx->seq_work2,deluxe_ctx->seq_work1);CHKERRQ(ierr); 163 ierr = VecScatterBegin(deluxe_ctx->seq_scctx,deluxe_ctx->seq_work1,y,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 164 ierr = VecScatterEnd(deluxe_ctx->seq_scctx,deluxe_ctx->seq_work1,y,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 165 } 166 /* parallel part */ 167 for (i=0;i<deluxe_ctx->par_colors;i++) { 168 if (deluxe_ctx->par_ksp[i]) { 169 PetscInt subidx = deluxe_ctx->par_col2sub[i]; 170 /* restrict on subset */ 171 ierr = VecScatterBegin(deluxe_ctx->par_scctx_s[i],y,sub_schurs->work1[subidx],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 172 ierr = VecScatterEnd(deluxe_ctx->par_scctx_s[i],y,sub_schurs->work1[subidx],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 173 /* (\sum_j S_Ej)^-T */ 174 ierr = VecSet(deluxe_ctx->par_vec[i],0.0);CHKERRQ(ierr); 175 ierr = VecScatterBegin(deluxe_ctx->par_scctx_p[i],sub_schurs->work1[subidx],deluxe_ctx->par_vec[i],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 176 ierr = VecScatterEnd(deluxe_ctx->par_scctx_p[i],sub_schurs->work1[subidx],deluxe_ctx->par_vec[i],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 177 ierr = KSPSolveTranspose(deluxe_ctx->par_ksp[i],deluxe_ctx->par_vec[i],deluxe_ctx->par_vec[i]);CHKERRQ(ierr); 178 ierr = VecScatterBegin(deluxe_ctx->par_scctx_p[i],deluxe_ctx->par_vec[i],sub_schurs->work1[subidx],INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 179 ierr = VecScatterEnd(deluxe_ctx->par_scctx_p[i],deluxe_ctx->par_vec[i],sub_schurs->work1[subidx],INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 180 /* S_Ej^T */ 181 ierr = MatMultTranspose(sub_schurs->S_Ej[subidx],sub_schurs->work1[subidx],sub_schurs->work2[subidx]);CHKERRQ(ierr); 182 /* extend to boundary */ 183 ierr = VecScatterBegin(deluxe_ctx->par_scctx_s[i],sub_schurs->work2[subidx],y,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 184 ierr = VecScatterEnd(deluxe_ctx->par_scctx_s[i],sub_schurs->work2[subidx],y,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 185 } 186 } 187 PetscFunctionReturn(0); 188 } 189 190 #undef __FUNCT__ 191 #define __FUNCT__ "PCBDDCScalingRestriction" 192 PetscErrorCode PCBDDCScalingRestriction(PC pc, Vec global_vector, Vec local_interface_vector) 193 { 194 PC_BDDC *pcbddc=(PC_BDDC*)pc->data; 195 PetscErrorCode ierr; 196 197 PetscFunctionBegin; 198 PetscValidHeaderSpecific(pc,PC_CLASSID,1); 199 PetscValidHeaderSpecific(global_vector,VEC_CLASSID,2); 200 PetscValidHeaderSpecific(local_interface_vector,VEC_CLASSID,3); 201 if (local_interface_vector == pcbddc->work_scaling) { 202 SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Local vector should cannot be pcbddc->work_scaling!\n"); 203 } 204 ierr = PetscTryMethod(pc,"PCBDDCScalingRestriction_C",(PC,Vec,Vec),(pc,global_vector,local_interface_vector));CHKERRQ(ierr); 205 PetscFunctionReturn(0); 206 } 207 208 #undef __FUNCT__ 209 #define __FUNCT__ "PCBDDCScalingSetUp" 210 PetscErrorCode PCBDDCScalingSetUp(PC pc) 211 { 212 PC_IS* pcis=(PC_IS*)pc->data; 213 PC_BDDC* pcbddc=(PC_BDDC*)pc->data; 214 PetscErrorCode ierr; 215 216 PetscFunctionBegin; 217 PetscValidHeaderSpecific(pc,PC_CLASSID,1); 218 /* create work vector for the operator */ 219 ierr = VecDestroy(&pcbddc->work_scaling);CHKERRQ(ierr); 220 ierr = VecDuplicate(pcis->vec1_B,&pcbddc->work_scaling);CHKERRQ(ierr); 221 /* always rebuild pcis->D */ 222 if (pcis->use_stiffness_scaling) { 223 ierr = MatGetDiagonal(pcbddc->local_mat,pcis->vec1_N);CHKERRQ(ierr); 224 ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 225 ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 226 } 227 ierr = VecCopy(pcis->D,pcis->vec1_B);CHKERRQ(ierr); 228 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 229 ierr = VecScatterBegin(pcis->global_to_B,pcis->vec1_B,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 230 ierr = VecScatterEnd(pcis->global_to_B,pcis->vec1_B,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 231 ierr = VecScatterBegin(pcis->global_to_B,pcis->vec1_global,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 232 ierr = VecScatterEnd(pcis->global_to_B,pcis->vec1_global,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 233 ierr = VecPointwiseDivide(pcis->D,pcis->D,pcis->vec1_B);CHKERRQ(ierr); 234 /* now setup */ 235 if (pcbddc->use_deluxe_scaling) { 236 if (!pcbddc->deluxe_ctx) { 237 ierr = PCBDDCScalingCreate_Deluxe(pc);CHKERRQ(ierr); 238 } 239 ierr = PCBDDCScalingSetUp_Deluxe(pc);CHKERRQ(ierr); 240 ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCScalingRestriction_C",PCBDDCScalingRestriction_Deluxe);CHKERRQ(ierr); 241 ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCScalingExtension_C",PCBDDCScalingExtension_Deluxe);CHKERRQ(ierr); 242 } else { 243 ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCScalingRestriction_C",PCBDDCScalingRestriction_Basic);CHKERRQ(ierr); 244 ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCScalingExtension_C",PCBDDCScalingExtension_Basic);CHKERRQ(ierr); 245 } 246 247 /* test */ 248 if (pcbddc->dbg_flag) { 249 Vec vec2_global; 250 PetscViewer viewer=pcbddc->dbg_viewer; 251 PetscReal error; 252 253 /* extension -> from local to parallel */ 254 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 255 ierr = VecSetRandom(pcis->vec1_B,NULL);CHKERRQ(ierr); 256 ierr = VecScatterBegin(pcis->global_to_B,pcis->vec1_B,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 257 ierr = VecScatterEnd(pcis->global_to_B,pcis->vec1_B,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 258 ierr = VecDuplicate(pcis->vec1_global,&vec2_global);CHKERRQ(ierr); 259 ierr = VecCopy(pcis->vec1_global,vec2_global);CHKERRQ(ierr); 260 261 ierr = VecScatterBegin(pcis->global_to_B,pcis->vec1_global,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 262 ierr = VecScatterEnd(pcis->global_to_B,pcis->vec1_global,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 263 ierr = PCBDDCScalingExtension(pc,pcis->vec1_B,pcis->vec1_global);CHKERRQ(ierr); 264 ierr = VecAXPY(pcis->vec1_global,-1.0,vec2_global);CHKERRQ(ierr); 265 ierr = VecNorm(pcis->vec1_global,NORM_INFINITY,&error);CHKERRQ(ierr); 266 ierr = PetscViewerASCIIPrintf(viewer,"Error scaling extension %1.14e\n",error);CHKERRQ(ierr); 267 if (error>1.e-8 && pcbddc->dbg_flag>1) { 268 ierr = VecView(pcis->vec1_global,viewer);CHKERRQ(ierr); 269 } 270 ierr = VecDestroy(&vec2_global);CHKERRQ(ierr); 271 272 /* restriction -> from parallel to local */ 273 ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr); 274 ierr = VecSetRandom(pcis->vec1_B,NULL);CHKERRQ(ierr); 275 ierr = VecScatterBegin(pcis->global_to_B,pcis->vec1_B,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 276 ierr = VecScatterEnd(pcis->global_to_B,pcis->vec1_B,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 277 278 ierr = PCBDDCScalingRestriction(pc,pcis->vec1_global,pcis->vec1_B);CHKERRQ(ierr); 279 ierr = VecScale(pcis->vec1_B,-1.0);CHKERRQ(ierr); 280 ierr = VecScatterBegin(pcis->global_to_B,pcis->vec1_B,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 281 ierr = VecScatterEnd(pcis->global_to_B,pcis->vec1_B,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 282 ierr = VecNorm(pcis->vec1_global,NORM_INFINITY,&error);CHKERRQ(ierr); 283 ierr = PetscViewerASCIIPrintf(viewer,"Error scaling restriction %1.14e\n",error);CHKERRQ(ierr); 284 if (error>1.e-8 && pcbddc->dbg_flag>1) { 285 ierr = VecView(pcis->vec1_global,viewer);CHKERRQ(ierr); 286 } 287 } 288 PetscFunctionReturn(0); 289 } 290 291 #undef __FUNCT__ 292 #define __FUNCT__ "PCBDDCScalingDestroy" 293 PetscErrorCode PCBDDCScalingDestroy(PC pc) 294 { 295 PC_BDDC* pcbddc=(PC_BDDC*)pc->data; 296 PetscErrorCode ierr; 297 298 PetscFunctionBegin; 299 if (pcbddc->deluxe_ctx) { 300 ierr = PCBDDCScalingDestroy_Deluxe(pc);CHKERRQ(ierr); 301 } 302 ierr = VecDestroy(&pcbddc->work_scaling);CHKERRQ(ierr); 303 /* remove functions */ 304 ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCScalingRestriction_C",NULL);CHKERRQ(ierr); 305 ierr = PetscObjectComposeFunction((PetscObject)pc,"PCBDDCScalingExtension_C",NULL);CHKERRQ(ierr); 306 PetscFunctionReturn(0); 307 } 308 309 #undef __FUNCT__ 310 #define __FUNCT__ "PCBDDCScalingCreate_Deluxe" 311 static PetscErrorCode PCBDDCScalingCreate_Deluxe(PC pc) 312 { 313 PC_BDDC* pcbddc=(PC_BDDC*)pc->data; 314 PCBDDCDeluxeScaling deluxe_ctx; 315 PetscErrorCode ierr; 316 317 PetscFunctionBegin; 318 ierr = PetscNew(&deluxe_ctx);CHKERRQ(ierr); 319 ierr = PCBDDCSubSchursCreate(&deluxe_ctx->sub_schurs);CHKERRQ(ierr); 320 pcbddc->deluxe_ctx = deluxe_ctx; 321 PetscFunctionReturn(0); 322 } 323 324 #undef __FUNCT__ 325 #define __FUNCT__ "PCBDDCScalingDestroy_Deluxe" 326 static PetscErrorCode PCBDDCScalingDestroy_Deluxe(PC pc) 327 { 328 PC_BDDC* pcbddc=(PC_BDDC*)pc->data; 329 PetscErrorCode ierr; 330 331 PetscFunctionBegin; 332 ierr = PCBDDCScalingReset_Deluxe_Solvers(pcbddc->deluxe_ctx);CHKERRQ(ierr); 333 ierr = PCBDDCSubSchursDestroy(&(pcbddc->deluxe_ctx->sub_schurs));CHKERRQ(ierr); 334 ierr = PetscFree(pcbddc->deluxe_ctx);CHKERRQ(ierr); 335 PetscFunctionReturn(0); 336 } 337 338 #undef __FUNCT__ 339 #define __FUNCT__ "PCBDDCScalingReset_Deluxe_Solvers" 340 static PetscErrorCode PCBDDCScalingReset_Deluxe_Solvers(PCBDDCDeluxeScaling deluxe_ctx) 341 { 342 PetscErrorCode ierr; 343 344 PetscFunctionBegin; 345 ierr = PetscFree(deluxe_ctx->idx_simple_B);CHKERRQ(ierr); 346 deluxe_ctx->n_simple = 0; 347 if (deluxe_ctx->seq_mat) { 348 ierr = VecScatterDestroy(&deluxe_ctx->seq_scctx);CHKERRQ(ierr); 349 ierr = VecDestroy(&deluxe_ctx->seq_work1);CHKERRQ(ierr); 350 ierr = VecDestroy(&deluxe_ctx->seq_work2);CHKERRQ(ierr); 351 ierr = MatDestroy(&deluxe_ctx->seq_mat);CHKERRQ(ierr); 352 ierr = KSPDestroy(&deluxe_ctx->seq_ksp);CHKERRQ(ierr); 353 } 354 if (deluxe_ctx->par_colors) { 355 PetscInt i; 356 for (i=0;i<deluxe_ctx->par_colors;i++) { 357 ierr = VecScatterDestroy(&deluxe_ctx->par_scctx_s[i]);CHKERRQ(ierr); 358 ierr = VecScatterDestroy(&deluxe_ctx->par_scctx_p[i]);CHKERRQ(ierr); 359 ierr = VecDestroy(&deluxe_ctx->par_vec[i]);CHKERRQ(ierr); 360 ierr = KSPDestroy(&deluxe_ctx->par_ksp[i]);CHKERRQ(ierr); 361 } 362 ierr = PetscFree5(deluxe_ctx->par_ksp, 363 deluxe_ctx->par_scctx_s, 364 deluxe_ctx->par_scctx_p, 365 deluxe_ctx->par_vec, 366 deluxe_ctx->par_col2sub);CHKERRQ(ierr); 367 } 368 deluxe_ctx->par_colors = 0; 369 PetscFunctionReturn(0); 370 } 371 372 #undef __FUNCT__ 373 #define __FUNCT__ "PCBDDCScalingSetUp_Deluxe" 374 static PetscErrorCode PCBDDCScalingSetUp_Deluxe(PC pc) 375 { 376 PC_IS *pcis=(PC_IS*)pc->data; 377 PC_BDDC *pcbddc=(PC_BDDC*)pc->data; 378 PCBDDCDeluxeScaling deluxe_ctx=pcbddc->deluxe_ctx; 379 PCBDDCSubSchurs sub_schurs=deluxe_ctx->sub_schurs; 380 PCBDDCGraph graph; 381 PetscInt *index_sequential,*index_parallel; 382 PetscInt *auxlocal_sequential,*auxlocal_parallel; 383 PetscInt *auxglobal_sequential,*auxglobal_parallel; 384 PetscInt *auxmapping; 385 PetscInt i,j,min_loc; 386 PetscInt n_sequential_problems,n_local_sequential_problems,n_parallel_problems,n_local_parallel_problems; 387 PetscErrorCode ierr; 388 389 PetscFunctionBegin; 390 /* throw away the solvers */ 391 ierr = PCBDDCScalingReset_Deluxe_Solvers(deluxe_ctx);CHKERRQ(ierr); 392 393 /* attach interface graph for determining subsets */ 394 if (pcbddc->deluxe_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */ 395 PetscInt *idx_V_N; 396 IS verticesIS; 397 ierr = PCBDDCGetPrimalVerticesLocalIdx(pc,&i,&idx_V_N);CHKERRQ(ierr); 398 ierr = ISCreateGeneral(PETSC_COMM_SELF,i,idx_V_N,PETSC_OWN_POINTER,&verticesIS);CHKERRQ(ierr); 399 ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr); 400 ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap);CHKERRQ(ierr); 401 ierr = PCBDDCGraphSetUp(graph,0,PETSC_NULL,pcbddc->DirichletBoundaries,0,PETSC_NULL,verticesIS);CHKERRQ(ierr); 402 ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr); 403 ierr = ISDestroy(&verticesIS);CHKERRQ(ierr); 404 /* 405 if (pcbddc->dbg_flag) { 406 ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr); 407 } 408 */ 409 } else { 410 graph = pcbddc->mat_graph; 411 } 412 413 /* map interface's subsets */ 414 j = 0; 415 for (i=0;i<graph->ncc;i++) { 416 j = PetscMax(j,graph->cptr[i+1]-graph->cptr[i]); 417 } 418 ierr = PetscMalloc5(j,&auxmapping, 419 graph->ncc,&auxlocal_sequential, 420 graph->ncc,&auxlocal_parallel, 421 graph->ncc,&index_sequential, 422 graph->ncc,&index_parallel);CHKERRQ(ierr); 423 424 n_local_sequential_problems = 0; 425 n_local_parallel_problems = 0; 426 deluxe_ctx->n_simple = 0; 427 for (i=0;i<graph->ncc;i++) { 428 PetscInt subset_size = graph->cptr[i+1]-graph->cptr[i]; 429 if (subset_size > 1) { 430 ierr = ISLocalToGlobalMappingApply(graph->l2gmap,subset_size,&graph->queue[graph->cptr[i]],auxmapping);CHKERRQ(ierr); 431 min_loc = 0; 432 for (j=1;j<subset_size;j++) { 433 if (auxmapping[j]<auxmapping[min_loc]) { 434 min_loc = j; 435 } 436 } 437 if (subset_size > pcbddc->deluxe_threshold) { 438 index_parallel[n_local_parallel_problems] = i; 439 auxlocal_parallel[n_local_parallel_problems] = graph->queue[graph->cptr[i]+min_loc]; 440 n_local_parallel_problems++; 441 } else { 442 index_sequential[n_local_sequential_problems] = i; 443 auxlocal_sequential[n_local_sequential_problems] = graph->queue[graph->cptr[i]+min_loc]; 444 n_local_sequential_problems++; 445 } 446 } else { 447 deluxe_ctx->n_simple++; 448 } 449 } 450 451 /* diagonal scaling on size 1 cc and on dirichlet boundary dofs */ 452 for (i=0;i<graph->nvtxs;i++) { 453 if (graph->count[i] && graph->special_dof[i] == PCBDDCGRAPH_DIRICHLET_MARK) { 454 deluxe_ctx->n_simple++; 455 } 456 } 457 ierr = PetscMalloc1(deluxe_ctx->n_simple,&deluxe_ctx->idx_simple_B);CHKERRQ(ierr); 458 deluxe_ctx->n_simple = 0; 459 for (i=0;i<graph->ncc;i++) { 460 if (graph->cptr[i+1]-graph->cptr[i]==1) { 461 deluxe_ctx->idx_simple_B[deluxe_ctx->n_simple++] = graph->queue[graph->cptr[i]]; 462 } 463 } 464 for (i=0;i<graph->nvtxs;i++) { 465 if (graph->count[i] && graph->special_dof[i] == PCBDDCGRAPH_DIRICHLET_MARK) { 466 deluxe_ctx->idx_simple_B[deluxe_ctx->n_simple++] = i; 467 } 468 } 469 ierr = ISGlobalToLocalMappingApply(pcbddc->BtoNmap,IS_GTOLM_DROP,deluxe_ctx->n_simple,deluxe_ctx->idx_simple_B,&i,deluxe_ctx->idx_simple_B);CHKERRQ(ierr); 470 if (i != deluxe_ctx->n_simple) { 471 SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error when mapping simple scaling dofs! %d != %d",i,deluxe_ctx->n_simple); 472 } 473 ierr = PetscSortInt(deluxe_ctx->n_simple,deluxe_ctx->idx_simple_B);CHKERRQ(ierr); 474 475 /* SetUp local schur complements on subsets TODO better reuse procedure */ 476 if (!sub_schurs->n_subs) { 477 Mat S_j; 478 PetscBool free_used_adj; 479 PetscInt *used_xadj,*used_adjncy; 480 481 /* decide the adjacency to be used for determining internal problems for local schur on subsets */ 482 free_used_adj = PETSC_FALSE; 483 if (pcbddc->deluxe_layers == -1) { 484 used_xadj = NULL; 485 used_adjncy = NULL; 486 } else { 487 if ((pcbddc->deluxe_use_useradj && pcbddc->mat_graph->xadj) || !pcbddc->deluxe_compute_rowadj) { 488 used_xadj = pcbddc->mat_graph->xadj; 489 used_adjncy = pcbddc->mat_graph->adjncy; 490 } else { 491 Mat mat_adj; 492 PetscBool flg_row=PETSC_TRUE; 493 const PetscInt *xadj,*adjncy; 494 PetscInt nvtxs; 495 496 ierr = MatConvert(pcbddc->local_mat,MATMPIADJ,MAT_INITIAL_MATRIX,&mat_adj);CHKERRQ(ierr); 497 ierr = MatGetRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr); 498 if (!flg_row) { 499 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatGetRowIJ called in %s\n",__FUNCT__); 500 } 501 ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr); 502 ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr); 503 ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr); 504 ierr = MatRestoreRowIJ(mat_adj,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr); 505 if (!flg_row) { 506 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__); 507 } 508 ierr = MatDestroy(&mat_adj);CHKERRQ(ierr); 509 free_used_adj = PETSC_TRUE; 510 } 511 } 512 513 /* Create Schur complement matrix */ 514 ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr); 515 ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr); 516 /* setup Schur complements on subsets */ 517 ierr = PCBDDCSubSchursSetUp(sub_schurs,S_j,pcis->is_I_local,pcis->is_B_local,graph->ncc,graph->cptr,graph->queue,used_xadj,used_adjncy,PETSC_TRUE,pcbddc->deluxe_layers);CHKERRQ(ierr); 518 ierr = MatDestroy(&S_j);CHKERRQ(ierr); 519 /* free adjacency */ 520 if (free_used_adj) { 521 ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr); 522 } 523 } 524 525 /* Number parallel problems */ 526 auxglobal_parallel = 0; 527 ierr = PCBDDCSubsetNumbering(PetscObjectComm((PetscObject)pc),graph->l2gmap,n_local_parallel_problems,auxlocal_parallel,PETSC_NULL,&n_parallel_problems,&auxglobal_parallel);CHKERRQ(ierr); 528 if (pcbddc->dbg_flag) { 529 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Deluxe global number of parallel subproblems: %d\n",n_parallel_problems); 530 } 531 532 /* Compute data structures to solve parallel problems */ 533 ierr = PCBDDCScalingSetUp_Deluxe_Par(pc,n_local_parallel_problems,n_parallel_problems,auxglobal_parallel,index_parallel);CHKERRQ(ierr); 534 ierr = PetscFree(auxglobal_parallel);CHKERRQ(ierr); 535 536 537 /* Number sequential problems */ 538 auxglobal_sequential = 0; 539 ierr = PCBDDCSubsetNumbering(PetscObjectComm((PetscObject)pc),graph->l2gmap,n_local_sequential_problems,auxlocal_sequential,PETSC_NULL,&n_sequential_problems,&auxglobal_sequential);CHKERRQ(ierr); 540 if (pcbddc->dbg_flag) { 541 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Deluxe global number of sequential subproblems: %d\n",n_sequential_problems); 542 } 543 544 /* Compute data structures to solve sequential problems */ 545 ierr = PCBDDCScalingSetUp_Deluxe_Seq(pc,n_local_sequential_problems,n_sequential_problems,auxglobal_sequential,index_sequential);CHKERRQ(ierr); 546 ierr = PetscFree(auxglobal_sequential);CHKERRQ(ierr); 547 548 /* free workspace */ 549 ierr = PetscFree5(auxmapping,auxlocal_sequential,auxlocal_parallel,index_sequential,index_parallel);CHKERRQ(ierr); 550 551 /* free graph struct */ 552 if (pcbddc->deluxe_rebuild) { 553 ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr); 554 } 555 PetscFunctionReturn(0); 556 } 557 558 #undef __FUNCT__ 559 #define __FUNCT__ "PCBDDCScalingSetUp_Deluxe_Par" 560 static PetscErrorCode PCBDDCScalingSetUp_Deluxe_Par(PC pc, PetscInt n_local_parallel_problems,PetscInt n_parallel_problems,PetscInt global_parallel[],PetscInt index_parallel[]) 561 { 562 PC_BDDC *pcbddc=(PC_BDDC*)pc->data; 563 PCBDDCDeluxeScaling deluxe_ctx=pcbddc->deluxe_ctx; 564 /* coloring */ 565 Mat parallel_problems; 566 MatColoring coloring_obj; 567 ISColoring coloring_parallel_problems; 568 IS *par_is_colors,*is_colors; 569 /* working stuff */ 570 PetscInt i,j; 571 PetscErrorCode ierr; 572 573 PetscFunctionBegin; 574 if (!n_parallel_problems) { 575 PetscFunctionReturn(0); 576 } 577 /* Color parallel subproblems */ 578 ierr = MatCreate(PetscObjectComm((PetscObject)pc),¶llel_problems);CHKERRQ(ierr); 579 ierr = MatSetSizes(parallel_problems,PETSC_DECIDE,PETSC_DECIDE,n_parallel_problems,n_parallel_problems);CHKERRQ(ierr); 580 ierr = MatSetType(parallel_problems,MATAIJ);CHKERRQ(ierr); 581 ierr = MatSetUp(parallel_problems);CHKERRQ(ierr); 582 ierr = MatSetOption(parallel_problems,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr); 583 ierr = MatSetOption(parallel_problems,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr); 584 for (i=0;i<n_local_parallel_problems;i++) { 585 PetscInt row = global_parallel[i]; 586 for (j=0;j<n_local_parallel_problems;j++) { 587 PetscInt col = global_parallel[j]; 588 if (row != col) { 589 ierr = MatSetValue(parallel_problems,row,col,1.0,INSERT_VALUES);CHKERRQ(ierr); 590 } 591 } 592 } 593 ierr = MatAssemblyBegin(parallel_problems,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 594 ierr = MatAssemblyEnd(parallel_problems,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 595 if (pcbddc->dbg_flag > 1) { 596 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 597 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Adj matrix for deluxe parallel problems\n");CHKERRQ(ierr); 598 ierr = MatView(parallel_problems,pcbddc->dbg_viewer);CHKERRQ(ierr); 599 } 600 ierr = MatColoringCreate(parallel_problems,&coloring_obj);CHKERRQ(ierr); 601 ierr = MatColoringSetDistance(coloring_obj,1);CHKERRQ(ierr); 602 ierr = MatColoringSetType(coloring_obj,MATCOLORINGJP);CHKERRQ(ierr); 603 ierr = MatColoringApply(coloring_obj,&coloring_parallel_problems);CHKERRQ(ierr); 604 ierr = ISColoringGetIS(coloring_parallel_problems,&deluxe_ctx->par_colors,&par_is_colors);CHKERRQ(ierr); 605 if (pcbddc->dbg_flag) { 606 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 607 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Number of colors %d for parallel part of deluxe\n",deluxe_ctx->par_colors);CHKERRQ(ierr); 608 } 609 610 /* all procs should know the color distribution */ 611 ierr = PetscMalloc1(deluxe_ctx->par_colors,&is_colors);CHKERRQ(ierr); 612 for (i=0;i<deluxe_ctx->par_colors;i++) { 613 if (pcbddc->dbg_flag) { 614 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Global problem indexes for color %d\n",i);CHKERRQ(ierr); 615 ierr = ISView(par_is_colors[i],pcbddc->dbg_viewer);CHKERRQ(ierr); 616 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 617 } 618 ierr = ISAllGather(par_is_colors[i],&is_colors[i]);CHKERRQ(ierr); 619 } 620 621 /* free unneeded objects */ 622 ierr = ISColoringRestoreIS(coloring_parallel_problems,&par_is_colors);CHKERRQ(ierr); 623 ierr = ISColoringDestroy(&coloring_parallel_problems);CHKERRQ(ierr); 624 ierr = MatColoringDestroy(&coloring_obj);CHKERRQ(ierr); 625 ierr = MatDestroy(¶llel_problems);CHKERRQ(ierr); 626 627 /* allocate deluxe arrays for parallel problems */ 628 ierr = PetscMalloc5(deluxe_ctx->par_colors,&deluxe_ctx->par_ksp, 629 deluxe_ctx->par_colors,&deluxe_ctx->par_scctx_s, 630 deluxe_ctx->par_colors,&deluxe_ctx->par_scctx_p, 631 deluxe_ctx->par_colors,&deluxe_ctx->par_vec, 632 deluxe_ctx->par_colors,&deluxe_ctx->par_col2sub);CHKERRQ(ierr); 633 634 /* cycle on colors */ 635 for (i=0;i<deluxe_ctx->par_colors;i++) { 636 PetscSubcomm par_subcomm; 637 const PetscInt* idxs_subproblems; 638 PetscInt color_size; 639 PetscMPIInt rank,active_color; 640 641 /* get local index of i-th parallel colored problem */ 642 ierr = ISGetLocalSize(is_colors[i],&color_size);CHKERRQ(ierr); 643 ierr = ISGetIndices(is_colors[i],&idxs_subproblems);CHKERRQ(ierr); 644 /* split comm for computing parallel problems for this color */ 645 /* Processes not partecipating at this stage will have color = color_size */ 646 /* because PetscCommDuplicate does not handle MPI_COMM_NULL */ 647 active_color = color_size; 648 deluxe_ctx->par_col2sub[i] = -1; 649 for (j=0;j<n_local_parallel_problems;j++) { 650 PetscInt local_idx; 651 ierr = PetscFindInt(global_parallel[j],color_size,idxs_subproblems,&local_idx);CHKERRQ(ierr); 652 if (local_idx > -1) { 653 ierr = PetscMPIIntCast(local_idx,&active_color);CHKERRQ(ierr); 654 deluxe_ctx->par_col2sub[i] = index_parallel[j]; 655 break; 656 } 657 } 658 ierr = ISRestoreIndices(is_colors[i],&idxs_subproblems);CHKERRQ(ierr); 659 ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)pc),&par_subcomm);CHKERRQ(ierr); 660 ierr = PetscSubcommSetNumber(par_subcomm,color_size+1);CHKERRQ(ierr); 661 ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr); 662 ierr = PetscSubcommSetTypeGeneral(par_subcomm,active_color,rank);CHKERRQ(ierr); 663 /* print debug info */ 664 if (pcbddc->dbg_flag) { 665 PetscMPIInt crank,csize; 666 ierr = MPI_Comm_rank(par_subcomm->comm,&crank);CHKERRQ(ierr); 667 ierr = MPI_Comm_size(par_subcomm->comm,&csize);CHKERRQ(ierr); 668 ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Color %d: size %d, details follows.\n",i,color_size);CHKERRQ(ierr); 669 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 670 ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr); 671 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer," Subdomain %d: color in subcomm %d (rank %d out of %d) (lidx %d)\n",PetscGlobalRank,par_subcomm->color,crank,csize,deluxe_ctx->par_col2sub[i]);CHKERRQ(ierr); 672 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 673 } 674 675 if (deluxe_ctx->par_col2sub[i] >= 0) { 676 PC pc; 677 Mat color_mat,color_mat_is,temp_mat; 678 ISLocalToGlobalMapping WtoNmap,l2gmap_subset; 679 IS is_local_numbering,isB_local,isW_local,isW; 680 PCBDDCSubSchurs sub_schurs = deluxe_ctx->sub_schurs; 681 PetscInt subidx,n_local_dofs,n_global_dofs; 682 PetscInt *global_numbering,*local_numbering; 683 char ksp_prefix[256]; 684 size_t len; 685 686 /* Local index for schur complement on subset */ 687 subidx = deluxe_ctx->par_col2sub[i]; 688 689 /* Parallel numbering for dofs in colored subset */ 690 ierr = ISSum(sub_schurs->is_AEj_I[subidx],sub_schurs->is_AEj_B[subidx],&is_local_numbering);CHKERRQ(ierr); 691 ierr = ISGetLocalSize(is_local_numbering,&n_local_dofs);CHKERRQ(ierr); 692 ierr = ISGetIndices(is_local_numbering,(const PetscInt **)&local_numbering);CHKERRQ(ierr); 693 ierr = PCBDDCSubsetNumbering(par_subcomm->comm,pcbddc->mat_graph->l2gmap,n_local_dofs,local_numbering,PETSC_NULL,&n_global_dofs,&global_numbering);CHKERRQ(ierr); 694 ierr = ISRestoreIndices(is_local_numbering,(const PetscInt **)&local_numbering);CHKERRQ(ierr); 695 696 /* L2Gmap from relevant dofs to local dofs */ 697 ierr = ISLocalToGlobalMappingCreateIS(is_local_numbering,&WtoNmap);CHKERRQ(ierr); 698 699 /* L2Gmap from local to global dofs */ 700 ierr = ISLocalToGlobalMappingCreate(par_subcomm->comm,1,n_local_dofs,global_numbering,PETSC_COPY_VALUES,&l2gmap_subset);CHKERRQ(ierr); 701 702 /* compute parallel matrix (extended dirichlet problem on subset) */ 703 ierr = MatCreateIS(par_subcomm->comm,1,PETSC_DECIDE,PETSC_DECIDE,n_global_dofs,n_global_dofs,l2gmap_subset,&color_mat_is);CHKERRQ(ierr); 704 ierr = MatGetSubMatrix(pcbddc->local_mat,is_local_numbering,is_local_numbering,MAT_INITIAL_MATRIX,&temp_mat);CHKERRQ(ierr); 705 ierr = MatISSetLocalMat(color_mat_is,temp_mat);CHKERRQ(ierr); 706 ierr = MatDestroy(&temp_mat);CHKERRQ(ierr); 707 ierr = MatISGetMPIXAIJ(color_mat_is,MAT_INITIAL_MATRIX,&color_mat);CHKERRQ(ierr); 708 ierr = MatDestroy(&color_mat_is);CHKERRQ(ierr); 709 710 /* work vector for (parallel) extended dirichlet problem */ 711 ierr = MatGetVecs(color_mat,&deluxe_ctx->par_vec[i],NULL);CHKERRQ(ierr); 712 713 /* compute scatters */ 714 /* deluxe_ctx->par_scctx_p[i] extension from local subset to extended dirichlet problem 715 deluxe_ctx->par_scctx_s[i] restriction from local boundary to subset -> simple copy of selected values */ 716 ierr = ISGlobalToLocalMappingApplyIS(pcbddc->BtoNmap,IS_GTOLM_DROP,sub_schurs->is_AEj_B[subidx],&isB_local);CHKERRQ(ierr); 717 ierr = VecScatterCreate(pcbddc->work_scaling,isB_local,sub_schurs->work1[subidx],NULL,&deluxe_ctx->par_scctx_s[i]);CHKERRQ(ierr); 718 ierr = ISGlobalToLocalMappingApplyIS(WtoNmap,IS_GTOLM_DROP,sub_schurs->is_AEj_B[subidx],&isW_local);CHKERRQ(ierr); 719 ierr = ISLocalToGlobalMappingApplyIS(l2gmap_subset,isW_local,&isW);CHKERRQ(ierr); 720 ierr = VecScatterCreate(sub_schurs->work1[subidx],NULL,deluxe_ctx->par_vec[i],isW,&deluxe_ctx->par_scctx_p[i]);CHKERRQ(ierr); 721 722 /* free objects no longer neeeded */ 723 ierr = ISDestroy(&isW);CHKERRQ(ierr); 724 ierr = ISDestroy(&isW_local);CHKERRQ(ierr); 725 ierr = ISDestroy(&isB_local);CHKERRQ(ierr); 726 ierr = ISLocalToGlobalMappingDestroy(&WtoNmap);CHKERRQ(ierr); 727 ierr = ISLocalToGlobalMappingDestroy(&l2gmap_subset);CHKERRQ(ierr); 728 ierr = ISDestroy(&is_local_numbering);CHKERRQ(ierr); 729 ierr = PetscFree(global_numbering);CHKERRQ(ierr); 730 731 /* KSP for extended dirichlet problem */ 732 ierr = KSPCreate(par_subcomm->comm,&deluxe_ctx->par_ksp[i]);CHKERRQ(ierr); 733 ierr = KSPSetOperators(deluxe_ctx->par_ksp[i],color_mat,color_mat);CHKERRQ(ierr); 734 ierr = KSPSetTolerances(deluxe_ctx->par_ksp[i],1.e-12,1.e-12,1.e10,10000);CHKERRQ(ierr); 735 ierr = KSPSetType(deluxe_ctx->par_ksp[i],KSPPREONLY);CHKERRQ(ierr); 736 ierr = KSPGetPC(deluxe_ctx->par_ksp[i],&pc);CHKERRQ(ierr); 737 ierr = PCSetType(pc,PCREDUNDANT);CHKERRQ(ierr); 738 ierr = PetscStrlen(((PetscObject)(pcbddc->ksp_D))->prefix,&len);CHKERRQ(ierr); 739 len -= 10; /* remove "dirichlet_" */ 740 ierr = PetscStrncpy(ksp_prefix,((PetscObject)(pcbddc->ksp_D))->prefix,len+1);CHKERRQ(ierr); /* PetscStrncpy puts a terminating char at the end */ 741 ierr = PetscStrcat(ksp_prefix,"deluxe_par_");CHKERRQ(ierr); 742 ierr = KSPSetOptionsPrefix(deluxe_ctx->par_ksp[i],ksp_prefix);CHKERRQ(ierr); 743 ierr = KSPSetFromOptions(deluxe_ctx->par_ksp[i]);CHKERRQ(ierr); 744 ierr = KSPSetUp(deluxe_ctx->par_ksp[i]);CHKERRQ(ierr); 745 ierr = MatDestroy(&color_mat);CHKERRQ(ierr); 746 } else { /* not partecipating in color */ 747 deluxe_ctx->par_ksp[i] = 0; 748 deluxe_ctx->par_vec[i] = 0; 749 deluxe_ctx->par_scctx_p[i] = 0; 750 deluxe_ctx->par_scctx_s[i] = 0; 751 } 752 ierr = PetscSubcommDestroy(&par_subcomm);CHKERRQ(ierr); 753 } 754 for (i=0;i<deluxe_ctx->par_colors;i++) { 755 ierr = ISDestroy(&is_colors[i]);CHKERRQ(ierr); 756 } 757 ierr = PetscFree(is_colors);CHKERRQ(ierr); 758 759 if (pcbddc->dbg_flag) { 760 Vec test_vec; 761 PetscReal error; 762 PCBDDCSubSchurs sub_schurs = deluxe_ctx->sub_schurs; 763 /* test partition of unity of coloured schur complements */ 764 for (i=0;i<deluxe_ctx->par_colors;i++) { 765 PetscInt subidx = deluxe_ctx->par_col2sub[i]; 766 PetscBool error_found = PETSC_FALSE; 767 ierr = PetscViewerASCIISynchronizedAllow(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr); 768 769 if (deluxe_ctx->par_ksp[i]) { 770 /* create random test vec being zero on internal nodes of the extende dirichlet problem */ 771 ierr = VecDuplicate(deluxe_ctx->par_vec[i],&test_vec);CHKERRQ(ierr); 772 ierr = VecSetRandom(sub_schurs->work1[subidx],PETSC_NULL);CHKERRQ(ierr); 773 ierr = VecSet(test_vec,0.0);CHKERRQ(ierr); 774 ierr = VecScatterBegin(deluxe_ctx->par_scctx_p[i],sub_schurs->work1[subidx],test_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 775 ierr = VecScatterEnd(deluxe_ctx->par_scctx_p[i],sub_schurs->work1[subidx],test_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 776 /* w_j */ 777 ierr = VecScatterBegin(deluxe_ctx->par_scctx_p[i],test_vec,sub_schurs->work1[subidx],INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 778 ierr = VecScatterEnd(deluxe_ctx->par_scctx_p[i],test_vec,sub_schurs->work1[subidx],INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 779 /* S_j*w_j */ 780 ierr = MatMult(sub_schurs->S_Ej[subidx],sub_schurs->work1[subidx],sub_schurs->work2[subidx]);CHKERRQ(ierr); 781 /* \sum_j S_j*w_j */ 782 ierr = VecSet(deluxe_ctx->par_vec[i],0.0);CHKERRQ(ierr); 783 ierr = VecScatterBegin(deluxe_ctx->par_scctx_p[i],sub_schurs->work2[subidx],deluxe_ctx->par_vec[i],ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 784 ierr = VecScatterEnd(deluxe_ctx->par_scctx_p[i],sub_schurs->work2[subidx],deluxe_ctx->par_vec[i],ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 785 /* (\sum_j S_j)^(-1)(\sum_j S_j*w_j) */ 786 ierr = KSPSolve(deluxe_ctx->par_ksp[i],deluxe_ctx->par_vec[i],deluxe_ctx->par_vec[i]);CHKERRQ(ierr); 787 ierr = VecScatterBegin(deluxe_ctx->par_scctx_p[i],deluxe_ctx->par_vec[i],sub_schurs->work1[subidx],INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 788 ierr = VecScatterEnd(deluxe_ctx->par_scctx_p[i],deluxe_ctx->par_vec[i],sub_schurs->work1[subidx],INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr); 789 ierr = VecSet(deluxe_ctx->par_vec[i],0.0);CHKERRQ(ierr); 790 ierr = VecScatterBegin(deluxe_ctx->par_scctx_p[i],sub_schurs->work1[subidx],deluxe_ctx->par_vec[i],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 791 ierr = VecScatterEnd(deluxe_ctx->par_scctx_p[i],sub_schurs->work1[subidx],deluxe_ctx->par_vec[i],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 792 /* test partition of unity */ 793 ierr = VecAXPY(test_vec,-1.0,deluxe_ctx->par_vec[i]);CHKERRQ(ierr); 794 ierr = VecNorm(test_vec,NORM_INFINITY,&error);CHKERRQ(ierr); 795 if (PetscAbsReal(error) > 1.e-8) { 796 /* ierr = VecView(test_vec,0);CHKERRQ(ierr); */ 797 error_found = PETSC_TRUE; 798 } 799 ierr = VecDestroy(&test_vec);CHKERRQ(ierr); 800 } 801 if (error_found) { 802 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Error testing local schur for color %d and subdomain %d\n",i,PetscGlobalRank);CHKERRQ(ierr); 803 } 804 ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr); 805 } 806 } 807 PetscFunctionReturn(0); 808 } 809 810 811 #undef __FUNCT__ 812 #define __FUNCT__ "PCBDDCScalingSetUp_Deluxe_Seq" 813 static PetscErrorCode PCBDDCScalingSetUp_Deluxe_Seq(PC pc,PetscInt n_local_sequential_problems,PetscInt n_sequential_problems,PetscInt global_sequential[],PetscInt local_sequential[]) 814 { 815 PC_BDDC *pcbddc=(PC_BDDC*)pc->data; 816 PCBDDCDeluxeScaling deluxe_ctx=pcbddc->deluxe_ctx; 817 PCBDDCSubSchurs sub_schurs = deluxe_ctx->sub_schurs; 818 Mat global_schur_subsets,*submat_global_schur_subsets,work_mat; 819 IS is_to,is_from; 820 PetscScalar *array,*fill_vals; 821 PetscInt *all_local_idx_G,*all_local_idx_B,*all_local_idx_N,*all_permutation_G,*dummy_idx; 822 PetscInt i,j,k,local_problem_index; 823 PetscInt subset_size,max_subset_size,max_subset_size_red; 824 PetscInt local_size,global_size; 825 char ksp_prefix[256]; 826 size_t len; 827 PetscErrorCode ierr; 828 829 PetscFunctionBegin; 830 if (!n_sequential_problems) { 831 PetscFunctionReturn(0); 832 } 833 /* Get info on subset sizes and sum of all subsets sizes */ 834 max_subset_size = 0; 835 local_size = 0; 836 for (i=0;i<n_local_sequential_problems;i++) { 837 local_problem_index = local_sequential[i]; 838 ierr = ISGetLocalSize(sub_schurs->is_AEj_B[local_problem_index],&subset_size);CHKERRQ(ierr); 839 max_subset_size = PetscMax(subset_size,max_subset_size); 840 local_size += subset_size; 841 } 842 843 /* Work arrays for local indices */ 844 ierr = PetscMalloc1(local_size,&all_local_idx_B);CHKERRQ(ierr); 845 ierr = PetscMalloc1(local_size,&all_local_idx_N);CHKERRQ(ierr); 846 847 /* Get local indices in local whole numbering and local boundary numbering */ 848 local_size = 0; 849 for (i=0;i<n_local_sequential_problems;i++) { 850 PetscInt *idxs; 851 /* get info on local problem */ 852 local_problem_index = local_sequential[i]; 853 ierr = ISGetLocalSize(sub_schurs->is_AEj_B[local_problem_index],&subset_size);CHKERRQ(ierr); 854 ierr = ISGetIndices(sub_schurs->is_AEj_B[local_problem_index],(const PetscInt**)&idxs);CHKERRQ(ierr); 855 /* subset indices in local numbering */ 856 ierr = PetscMemcpy(all_local_idx_N+local_size,idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr); 857 /* subset indices in local boundary numbering */ 858 ierr = ISGlobalToLocalMappingApply(pcbddc->BtoNmap,IS_GTOLM_DROP,subset_size,idxs,&j,&all_local_idx_B[local_size]);CHKERRQ(ierr); 859 ierr = ISRestoreIndices(sub_schurs->is_AEj_B[local_problem_index],(const PetscInt**)&idxs);CHKERRQ(ierr); 860 if (j != subset_size) { 861 SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in BDDC deluxe serial %d (BtoNmap)! %d != %d\n",local_problem_index,subset_size,j); 862 } 863 local_size += subset_size; 864 } 865 866 /* Number dofs on all subsets (parallel) and sort numbering */ 867 ierr = PCBDDCSubsetNumbering(PetscObjectComm((PetscObject)pc),pcbddc->mat_graph->l2gmap,local_size,all_local_idx_N,PETSC_NULL,&global_size,&all_local_idx_G);CHKERRQ(ierr); 868 ierr = PetscMalloc1(local_size,&all_permutation_G);CHKERRQ(ierr); 869 for (i=0;i<local_size;i++) { 870 all_permutation_G[i]=i; 871 } 872 ierr = PetscSortIntWithPermutation(local_size,all_local_idx_G,all_permutation_G);CHKERRQ(ierr); 873 874 /* Local matrix of all local Schur on subsets */ 875 ierr = MatCreate(PETSC_COMM_SELF,&deluxe_ctx->seq_mat);CHKERRQ(ierr); 876 ierr = MatSetSizes(deluxe_ctx->seq_mat,PETSC_DECIDE,PETSC_DECIDE,local_size,local_size);CHKERRQ(ierr); 877 ierr = MatSetType(deluxe_ctx->seq_mat,MATAIJ);CHKERRQ(ierr); 878 ierr = MatSeqAIJSetPreallocation(deluxe_ctx->seq_mat,max_subset_size,PETSC_NULL);CHKERRQ(ierr); 879 880 /* Global matrix of all assembled Schur on subsets */ 881 ierr = MatCreate(PetscObjectComm((PetscObject)pc),&global_schur_subsets);CHKERRQ(ierr); 882 ierr = MatSetSizes(global_schur_subsets,PETSC_DECIDE,PETSC_DECIDE,global_size,global_size);CHKERRQ(ierr); 883 ierr = MatSetType(global_schur_subsets,MATAIJ);CHKERRQ(ierr); 884 ierr = MPI_Allreduce(&max_subset_size,&max_subset_size_red,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr); 885 ierr = MatMPIAIJSetPreallocation(global_schur_subsets,max_subset_size_red,PETSC_NULL,max_subset_size_red,PETSC_NULL);CHKERRQ(ierr); 886 887 /* Work arrays */ 888 ierr = PetscMalloc2(max_subset_size,&dummy_idx,max_subset_size*max_subset_size,&fill_vals);CHKERRQ(ierr); 889 890 /* Loop on local problems to compute Schur complements explicitly */ 891 local_size = 0; 892 for (i=0;i<n_local_sequential_problems;i++) { 893 /* get info on local problem */ 894 local_problem_index = local_sequential[i]; 895 ierr = ISGetLocalSize(sub_schurs->is_AEj_B[local_problem_index],&subset_size);CHKERRQ(ierr); 896 /* local Schur */ 897 for (j=0;j<subset_size;j++) { 898 ierr = VecSet(sub_schurs->work1[local_problem_index],0.0);CHKERRQ(ierr); 899 ierr = VecSetValue(sub_schurs->work1[local_problem_index],j,1.0,INSERT_VALUES);CHKERRQ(ierr); 900 ierr = MatMult(sub_schurs->S_Ej[local_problem_index],sub_schurs->work1[local_problem_index],sub_schurs->work2[local_problem_index]);CHKERRQ(ierr); 901 /* store vals */ 902 ierr = VecGetArray(sub_schurs->work2[local_problem_index],&array);CHKERRQ(ierr); 903 for (k=0;k<subset_size;k++) { 904 fill_vals[k*subset_size+j] = array[k]; 905 } 906 ierr = VecRestoreArray(sub_schurs->work2[local_problem_index],&array);CHKERRQ(ierr); 907 } 908 for (j=0;j<subset_size;j++) { 909 dummy_idx[j]=local_size+j; 910 } 911 ierr = MatSetValues(deluxe_ctx->seq_mat,subset_size,dummy_idx,subset_size,dummy_idx,fill_vals,INSERT_VALUES);CHKERRQ(ierr); 912 ierr = MatSetValues(global_schur_subsets,subset_size,&all_local_idx_G[local_size],subset_size,&all_local_idx_G[local_size],fill_vals,ADD_VALUES);CHKERRQ(ierr); 913 local_size += subset_size; 914 } 915 ierr = MatAssemblyBegin(deluxe_ctx->seq_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 916 ierr = MatAssemblyEnd(deluxe_ctx->seq_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 917 ierr = MatAssemblyBegin(global_schur_subsets,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 918 ierr = MatAssemblyEnd(global_schur_subsets,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 919 ierr = PetscFree2(dummy_idx,fill_vals);CHKERRQ(ierr); 920 921 /* Create work vectors for sequential part of deluxe */ 922 ierr = MatGetVecs(deluxe_ctx->seq_mat,&deluxe_ctx->seq_work1,&deluxe_ctx->seq_work2);CHKERRQ(ierr); 923 924 /* Compute deluxe sequential scatter */ 925 ierr = ISCreateGeneral(PETSC_COMM_SELF,local_size,all_local_idx_B,PETSC_OWN_POINTER,&is_from);CHKERRQ(ierr); 926 ierr = VecScatterCreate(pcbddc->work_scaling,is_from,deluxe_ctx->seq_work1,NULL,&deluxe_ctx->seq_scctx);CHKERRQ(ierr); 927 ierr = ISDestroy(&is_from);CHKERRQ(ierr); 928 929 /* Get local part of (\sum_j S_Ej) */ 930 for (i=0;i<local_size;i++) { 931 all_local_idx_N[i] = all_local_idx_G[all_permutation_G[i]]; 932 } 933 ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),local_size,all_local_idx_N,PETSC_OWN_POINTER,&is_to);CHKERRQ(ierr); 934 ierr = MatGetSubMatrices(global_schur_subsets,1,&is_to,&is_to,MAT_INITIAL_MATRIX,&submat_global_schur_subsets);CHKERRQ(ierr); 935 ierr = MatDestroy(&global_schur_subsets);CHKERRQ(ierr); 936 ierr = ISDestroy(&is_to);CHKERRQ(ierr); 937 for (i=0;i<local_size;i++) { 938 all_local_idx_G[all_permutation_G[i]] = i; 939 } 940 ierr = ISCreateGeneral(PETSC_COMM_SELF,local_size,all_local_idx_G,PETSC_OWN_POINTER,&is_from);CHKERRQ(ierr); 941 ierr = ISSetPermutation(is_from);CHKERRQ(ierr); 942 ierr = MatPermute(submat_global_schur_subsets[0],is_from,is_from,&work_mat);CHKERRQ(ierr); 943 ierr = MatDestroyMatrices(1,&submat_global_schur_subsets);CHKERRQ(ierr); 944 ierr = ISDestroy(&is_from);CHKERRQ(ierr); 945 ierr = PetscFree(all_permutation_G);CHKERRQ(ierr); 946 947 /* Create KSP object for sequential part of deluxe scaling */ 948 ierr = KSPCreate(PETSC_COMM_SELF,&deluxe_ctx->seq_ksp);CHKERRQ(ierr); 949 ierr = KSPSetOperators(deluxe_ctx->seq_ksp,work_mat,work_mat);CHKERRQ(ierr); 950 ierr = KSPSetType(deluxe_ctx->seq_ksp,KSPPREONLY);CHKERRQ(ierr); 951 ierr = PetscStrlen(((PetscObject)(pcbddc->ksp_D))->prefix,&len);CHKERRQ(ierr); 952 len -= 10; /* remove "dirichlet_" */ 953 ierr = PetscStrncpy(ksp_prefix,((PetscObject)(pcbddc->ksp_D))->prefix,len+1);CHKERRQ(ierr); 954 ierr = PetscStrcat(ksp_prefix,"deluxe_seq_");CHKERRQ(ierr); 955 ierr = KSPSetOptionsPrefix(deluxe_ctx->seq_ksp,ksp_prefix);CHKERRQ(ierr); 956 ierr = KSPSetFromOptions(deluxe_ctx->seq_ksp);CHKERRQ(ierr); 957 ierr = KSPSetUp(deluxe_ctx->seq_ksp);CHKERRQ(ierr); 958 ierr = MatDestroy(&work_mat);CHKERRQ(ierr); 959 PetscFunctionReturn(0); 960 } 961