PetscErrorCode SNESComputeJacobianDefaultColor(SNES snes,Vec x1,Mat J,Mat B,void *ctx) { MatFDColoring color = (MatFDColoring)ctx; PetscErrorCode ierr; DM dm; MatColoring mc; ISColoring iscoloring; PetscBool hascolor; PetscBool solvec,matcolor = PETSC_FALSE; PetscFunctionBegin; if (color) PetscValidHeaderSpecific(color,MAT_FDCOLORING_CLASSID,6); if (!color) {ierr = PetscObjectQuery((PetscObject)B,"SNESMatFDColoring",(PetscObject*)&color);CHKERRQ(ierr);} if (!color) { ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr); ierr = DMHasColoring(dm,&hascolor);CHKERRQ(ierr); matcolor = PETSC_FALSE; ierr = PetscOptionsGetBool(((PetscObject)snes)->options,((PetscObject)snes)->prefix,"-snes_fd_color_use_mat",&matcolor,NULL);CHKERRQ(ierr); if (hascolor && !matcolor) { ierr = DMCreateColoring(dm,IS_COLORING_GLOBAL,&iscoloring);CHKERRQ(ierr); ierr = MatFDColoringCreate(B,iscoloring,&color);CHKERRQ(ierr); ierr = MatFDColoringSetFunction(color,(PetscErrorCode (*)(void))SNESComputeFunctionCtx,NULL);CHKERRQ(ierr); ierr = MatFDColoringSetFromOptions(color);CHKERRQ(ierr); ierr = MatFDColoringSetUp(B,iscoloring,color);CHKERRQ(ierr); ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr); } else { ierr = MatColoringCreate(B,&mc);CHKERRQ(ierr); ierr = MatColoringSetDistance(mc,2);CHKERRQ(ierr); ierr = MatColoringSetType(mc,MATCOLORINGSL);CHKERRQ(ierr); ierr = MatColoringSetFromOptions(mc);CHKERRQ(ierr); ierr = MatColoringApply(mc,&iscoloring);CHKERRQ(ierr); ierr = MatColoringDestroy(&mc);CHKERRQ(ierr); ierr = MatFDColoringCreate(B,iscoloring,&color);CHKERRQ(ierr); ierr = MatFDColoringSetFunction(color,(PetscErrorCode (*)(void))SNESComputeFunctionCtx,NULL);CHKERRQ(ierr); ierr = MatFDColoringSetFromOptions(color);CHKERRQ(ierr); ierr = MatFDColoringSetUp(B,iscoloring,color);CHKERRQ(ierr); ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr); } ierr = PetscObjectCompose((PetscObject)B,"SNESMatFDColoring",(PetscObject)color);CHKERRQ(ierr); ierr = PetscObjectDereference((PetscObject)color);CHKERRQ(ierr); } /* F is only usable if there is no RHS on the SNES and the full solution corresponds to x1 */ ierr = VecEqual(x1,snes->vec_sol,&solvec);CHKERRQ(ierr); if (!snes->vec_rhs && solvec) { Vec F; ierr = SNESGetFunction(snes,&F,NULL,NULL);CHKERRQ(ierr); ierr = MatFDColoringSetF(color,F);CHKERRQ(ierr); } ierr = MatFDColoringApply(B,color,x1,snes);CHKERRQ(ierr); if (J != B) { ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); } PetscFunctionReturn(0); }
PetscErrorCode SNESComputeJacobianDefaultColor(SNES snes,Vec x1,Mat *J,Mat *B,MatStructure *flag,void *ctx) { MatFDColoring color = (MatFDColoring)ctx; PetscErrorCode ierr; DM dm; PetscErrorCode (*func)(SNES,Vec,Vec,void*); Vec F; void *funcctx; ISColoring iscoloring; PetscBool hascolor; PetscBool solvec; PetscFunctionBegin; if (color) PetscValidHeaderSpecific(color,MAT_FDCOLORING_CLASSID,6); else {ierr = PetscObjectQuery((PetscObject)*B,"SNESMatFDColoring",(PetscObject*)&color);CHKERRQ(ierr);} *flag = SAME_NONZERO_PATTERN; ierr = SNESGetFunction(snes,&F,&func,&funcctx);CHKERRQ(ierr); if (!color) { ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr); ierr = DMHasColoring(dm,&hascolor);CHKERRQ(ierr); if (hascolor) { ierr = DMCreateColoring(dm,IS_COLORING_GLOBAL,&iscoloring);CHKERRQ(ierr); ierr = MatFDColoringCreate(*B,iscoloring,&color);CHKERRQ(ierr); ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr); ierr = MatFDColoringSetFunction(color,(PetscErrorCode (*)(void))func,funcctx);CHKERRQ(ierr); ierr = MatFDColoringSetFromOptions(color);CHKERRQ(ierr); } else { ierr = MatGetColoring(*B,MATCOLORINGSL,&iscoloring);CHKERRQ(ierr); ierr = MatFDColoringCreate(*B,iscoloring,&color);CHKERRQ(ierr); ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr); ierr = MatFDColoringSetFunction(color,(PetscErrorCode (*)(void))func,(void*)funcctx);CHKERRQ(ierr); ierr = MatFDColoringSetFromOptions(color);CHKERRQ(ierr); } ierr = PetscObjectCompose((PetscObject)*B,"SNESMatFDColoring",(PetscObject)color);CHKERRQ(ierr); ierr = PetscObjectDereference((PetscObject)color);CHKERRQ(ierr); } /* F is only usable if there is no RHS on the SNES and the full solution corresponds to x1 */ ierr = VecEqual(x1,snes->vec_sol,&solvec);CHKERRQ(ierr); if (!snes->vec_rhs && solvec) { ierr = MatFDColoringSetF(color,F);CHKERRQ(ierr); } ierr = MatFDColoringApply(*B,color,x1,flag,snes);CHKERRQ(ierr); if (*J != *B) { ierr = MatAssemblyBegin(*J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(*J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); } PetscFunctionReturn(0); }
PETSC_EXTERN PetscErrorCode SNESComputeNGSDefaultSecant(SNES snes,Vec X,Vec B,void *ctx) { PetscErrorCode ierr; SNES_NGS *gs = (SNES_NGS*)snes->data; PetscInt i,j,k,ncolors; DM dm; PetscBool flg; ISColoring coloring = gs->coloring; MatColoring mc; Vec W,G,F; PetscScalar h=gs->h; IS *coloris; PetscScalar f,g,x,w,d; PetscReal dxt,xt,ft,ft1=0; const PetscInt *idx; PetscInt size,s; PetscReal atol,rtol,stol; PetscInt its; PetscErrorCode (*func)(SNES,Vec,Vec,void*); void *fctx; PetscBool mat = gs->secant_mat,equal,isdone,alldone; PetscScalar *xa,*fa,*wa,*ga; PetscFunctionBegin; if (snes->nwork < 3) { ierr = SNESSetWorkVecs(snes,3);CHKERRQ(ierr); } W = snes->work[0]; G = snes->work[1]; F = snes->work[2]; ierr = VecGetOwnershipRange(X,&s,NULL);CHKERRQ(ierr); ierr = SNESNGSGetTolerances(snes,&atol,&rtol,&stol,&its);CHKERRQ(ierr); ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr); ierr = SNESGetFunction(snes,NULL,&func,&fctx);CHKERRQ(ierr); if (!coloring) { /* create the coloring */ ierr = DMHasColoring(dm,&flg);CHKERRQ(ierr); if (flg && !mat) { ierr = DMCreateColoring(dm,IS_COLORING_GLOBAL,&coloring);CHKERRQ(ierr); } else { if (!snes->jacobian) {ierr = SNESSetUpMatrices(snes);CHKERRQ(ierr);} ierr = MatColoringCreate(snes->jacobian,&mc);CHKERRQ(ierr); ierr = MatColoringSetDistance(mc,1);CHKERRQ(ierr); ierr = MatColoringSetFromOptions(mc);CHKERRQ(ierr); ierr = MatColoringApply(mc,&coloring);CHKERRQ(ierr); ierr = MatColoringDestroy(&mc);CHKERRQ(ierr); } gs->coloring = coloring; } ierr = ISColoringGetIS(coloring,&ncolors,&coloris);CHKERRQ(ierr); ierr = VecEqual(X,snes->vec_sol,&equal);CHKERRQ(ierr); if (equal && snes->normschedule == SNES_NORM_ALWAYS) { /* assume that the function is already computed */ ierr = VecCopy(snes->vec_func,F);CHKERRQ(ierr); } else { ierr = PetscLogEventBegin(SNES_NGSFuncEval,snes,X,B,0);CHKERRQ(ierr); ierr = (*func)(snes,X,F,fctx);CHKERRQ(ierr); ierr = PetscLogEventEnd(SNES_NGSFuncEval,snes,X,B,0);CHKERRQ(ierr); if (B) {ierr = VecAXPY(F,-1.0,B);CHKERRQ(ierr);} } ierr = VecGetArray(X,&xa);CHKERRQ(ierr); ierr = VecGetArray(F,&fa);CHKERRQ(ierr); ierr = VecGetArray(G,&ga);CHKERRQ(ierr); ierr = VecGetArray(W,&wa);CHKERRQ(ierr); for (i=0;i<ncolors;i++) { ierr = ISGetIndices(coloris[i],&idx);CHKERRQ(ierr); ierr = ISGetLocalSize(coloris[i],&size);CHKERRQ(ierr); ierr = VecCopy(X,W);CHKERRQ(ierr); for (j=0;j<size;j++) { wa[idx[j]-s] += h; } ierr = PetscLogEventBegin(SNES_NGSFuncEval,snes,X,B,0);CHKERRQ(ierr); ierr = (*func)(snes,W,G,fctx);CHKERRQ(ierr); ierr = PetscLogEventEnd(SNES_NGSFuncEval,snes,X,B,0);CHKERRQ(ierr); if (B) {ierr = VecAXPY(G,-1.0,B);CHKERRQ(ierr);} for (k=0;k<its;k++) { dxt = 0.; xt = 0.; ft = 0.; for (j=0;j<size;j++) { f = fa[idx[j]-s]; x = xa[idx[j]-s]; g = ga[idx[j]-s]; w = wa[idx[j]-s]; if (PetscAbsScalar(g-f) > atol) { /* This is equivalent to d = x - (h*f) / PetscRealPart(g-f) */ d = (x*g-w*f) / PetscRealPart(g-f); } else { d = x; } dxt += PetscRealPart(PetscSqr(d-x)); xt += PetscRealPart(PetscSqr(x)); ft += PetscRealPart(PetscSqr(f)); xa[idx[j]-s] = d; } if (k == 0) ft1 = PetscSqrtReal(ft); if (k<its-1) { isdone = PETSC_FALSE; if (stol*PetscSqrtReal(xt) > PetscSqrtReal(dxt)) isdone = PETSC_TRUE; if (PetscSqrtReal(ft) < atol) isdone = PETSC_TRUE; if (rtol*ft1 > PetscSqrtReal(ft)) isdone = PETSC_TRUE; ierr = MPIU_Allreduce(&isdone,&alldone,1,MPIU_BOOL,MPI_BAND,PetscObjectComm((PetscObject)snes));CHKERRQ(ierr); if (alldone) break; } if (i < ncolors-1 || k < its-1) { ierr = PetscLogEventBegin(SNES_NGSFuncEval,snes,X,B,0);CHKERRQ(ierr); ierr = (*func)(snes,X,F,fctx);CHKERRQ(ierr); ierr = PetscLogEventEnd(SNES_NGSFuncEval,snes,X,B,0);CHKERRQ(ierr); if (B) {ierr = VecAXPY(F,-1.0,B);CHKERRQ(ierr);} } if (k<its-1) { ierr = VecSwap(X,W);CHKERRQ(ierr); ierr = VecSwap(F,G);CHKERRQ(ierr); } } } ierr = VecRestoreArray(X,&xa);CHKERRQ(ierr); ierr = VecRestoreArray(F,&fa);CHKERRQ(ierr); ierr = VecRestoreArray(G,&ga);CHKERRQ(ierr); ierr = VecRestoreArray(W,&wa);CHKERRQ(ierr); ierr = ISColoringRestoreIS(coloring,&coloris);CHKERRQ(ierr); PetscFunctionReturn(0); }