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); }
static PetscErrorCode SNESComputeJacobian_DMLocal(SNES snes,Vec X,Mat A,Mat B,void *ctx) { PetscErrorCode ierr; DM dm; DMSNES_Local *dmlocalsnes = (DMSNES_Local*)ctx; Vec Xloc; PetscFunctionBegin; ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr); if (dmlocalsnes->jacobianlocal) { ierr = DMGetLocalVector(dm,&Xloc);CHKERRQ(ierr); ierr = VecZeroEntries(Xloc);CHKERRQ(ierr); if (dmlocalsnes->boundarylocal) {ierr = (*dmlocalsnes->boundarylocal)(dm,Xloc,dmlocalsnes->boundarylocalctx);CHKERRQ(ierr);} ierr = DMGlobalToLocalBegin(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr); ierr = DMGlobalToLocalEnd(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr); CHKMEMQ; ierr = (*dmlocalsnes->jacobianlocal)(dm,Xloc,A,B,dmlocalsnes->jacobianlocalctx);CHKERRQ(ierr); CHKMEMQ; ierr = DMRestoreLocalVector(dm,&Xloc);CHKERRQ(ierr); } else { MatFDColoring fdcoloring; ierr = PetscObjectQuery((PetscObject)dm,"DMDASNES_FDCOLORING",(PetscObject*)&fdcoloring);CHKERRQ(ierr); if (!fdcoloring) { ISColoring coloring; ierr = DMCreateColoring(dm,dm->coloringtype,&coloring);CHKERRQ(ierr); ierr = MatFDColoringCreate(B,coloring,&fdcoloring);CHKERRQ(ierr); ierr = ISColoringDestroy(&coloring);CHKERRQ(ierr); switch (dm->coloringtype) { case IS_COLORING_GLOBAL: ierr = MatFDColoringSetFunction(fdcoloring,(PetscErrorCode (*)(void))SNESComputeFunction_DMLocal,dmlocalsnes);CHKERRQ(ierr); break; default: SETERRQ1(PetscObjectComm((PetscObject)snes),PETSC_ERR_SUP,"No support for coloring type '%s'",ISColoringTypes[dm->coloringtype]); } ierr = PetscObjectSetOptionsPrefix((PetscObject)fdcoloring,((PetscObject)dm)->prefix);CHKERRQ(ierr); ierr = MatFDColoringSetFromOptions(fdcoloring);CHKERRQ(ierr); ierr = MatFDColoringSetUp(B,coloring,fdcoloring);CHKERRQ(ierr); ierr = PetscObjectCompose((PetscObject)dm,"DMDASNES_FDCOLORING",(PetscObject)fdcoloring);CHKERRQ(ierr); ierr = PetscObjectDereference((PetscObject)fdcoloring);CHKERRQ(ierr); /* The following breaks an ugly reference counting loop that deserves a paragraph. MatFDColoringApply() will call * VecDuplicate() with the state Vec and store inside the MatFDColoring. This Vec will duplicate the Vec, but the * MatFDColoring is composed with the DM. We dereference the DM here so that the reference count will eventually * drop to 0. Note the code in DMDestroy() that exits early for a negative reference count. That code path will be * taken when the PetscObjectList for the Vec inside MatFDColoring is destroyed. */ ierr = PetscObjectDereference((PetscObject)dm);CHKERRQ(ierr); } ierr = MatFDColoringApply(B,fdcoloring,X,snes);CHKERRQ(ierr); } /* This will be redundant if the user called both, but it's too common to forget. */ if (A != B) { ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(A,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); }
PetscErrorCode DMCreateColoring_Composite(DM dm,ISColoringType ctype,MatType mtype,ISColoring *coloring) { PetscErrorCode ierr; PetscInt n,i,cnt; ISColoringValue *colors; PetscBool dense = PETSC_FALSE; ISColoringValue maxcol = 0; DM_Composite *com = (DM_Composite*)dm->data; PetscFunctionBegin; PetscValidHeaderSpecific(dm,DM_CLASSID,1); if (ctype == IS_COLORING_GHOSTED) SETERRQ(((PetscObject)dm)->comm,PETSC_ERR_SUP,"Only global coloring supported" ); else if (ctype == IS_COLORING_GLOBAL) { n = com->n; } else SETERRQ(((PetscObject)dm)->comm,PETSC_ERR_ARG_OUTOFRANGE,"Unknown ISColoringType"); ierr = PetscMalloc(n*sizeof(ISColoringValue),&colors);CHKERRQ(ierr); /* freed in ISColoringDestroy() */ ierr = PetscOptionsGetBool(PETSC_NULL,"-dmcomposite_dense_jacobian",&dense,PETSC_NULL);CHKERRQ(ierr); if (dense) { for (i=0; i<n; i++) { colors[i] = (ISColoringValue)(com->rstart + i); } maxcol = com->N; } else { struct DMCompositeLink *next = com->next; PetscMPIInt rank; ierr = MPI_Comm_rank(((PetscObject)dm)->comm,&rank);CHKERRQ(ierr); cnt = 0; while (next) { ISColoring lcoloring; ierr = DMCreateColoring(next->dm,IS_COLORING_GLOBAL,mtype,&lcoloring);CHKERRQ(ierr); for (i=0; i<lcoloring->N; i++) { colors[cnt++] = maxcol + lcoloring->colors[i]; } maxcol += lcoloring->n; ierr = ISColoringDestroy(&lcoloring);CHKERRQ(ierr); next = next->next; } } ierr = ISColoringCreate(((PetscObject)dm)->comm,maxcol,n,colors,coloring);CHKERRQ(ierr); PetscFunctionReturn(0); }
int main(int argc,char **argv) { PetscErrorCode ierr; int time; /* amount of loops */ struct in put; PetscScalar rh; /* relative humidity */ PetscScalar x; /* memory varialbe for relative humidity calculation */ PetscScalar deep_grnd_temp; /* temperature of ground under top soil surface layer */ PetscScalar emma; /* absorption-emission constant for air */ PetscScalar pressure1 = 101300; /* surface pressure */ PetscScalar mixratio; /* mixing ratio */ PetscScalar airtemp; /* temperature of air near boundary layer inversion */ PetscScalar dewtemp; /* dew point temperature */ PetscScalar sfctemp; /* temperature at surface */ PetscScalar pwat; /* total column precipitable water */ PetscScalar cloudTemp; /* temperature at base of cloud */ AppCtx user; /* user-defined work context */ MonitorCtx usermonitor; /* user-defined monitor context */ PetscMPIInt rank,size; TS ts; SNES snes; DM da; Vec T,rhs; /* solution vector */ Mat J; /* Jacobian matrix */ PetscReal ftime,dt; PetscInt steps,dof = 5; PetscBool use_coloring = PETSC_TRUE; MatFDColoring matfdcoloring = 0; PetscBool monitor_off = PETSC_FALSE; PetscInitialize(&argc,&argv,(char*)0,help); ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr); /* Inputs */ readinput(&put); sfctemp = put.Ts; dewtemp = put.Td; cloudTemp = put.Tc; airtemp = put.Ta; pwat = put.pwt; if (!rank) PetscPrintf(PETSC_COMM_SELF,"Initial Temperature = %g\n",sfctemp); /* input surface temperature */ deep_grnd_temp = sfctemp - 10; /* set underlying ground layer temperature */ emma = emission(pwat); /* accounts for radiative effects of water vapor */ /* Converts from Fahrenheit to Celsuis */ sfctemp = fahr_to_cel(sfctemp); airtemp = fahr_to_cel(airtemp); dewtemp = fahr_to_cel(dewtemp); cloudTemp = fahr_to_cel(cloudTemp); deep_grnd_temp = fahr_to_cel(deep_grnd_temp); /* Converts from Celsius to Kelvin */ sfctemp += 273; airtemp += 273; dewtemp += 273; cloudTemp += 273; deep_grnd_temp += 273; /* Calculates initial relative humidity */ x = calcmixingr(dewtemp,pressure1); mixratio = calcmixingr(sfctemp,pressure1); rh = (x/mixratio)*100; if (!rank) printf("Initial RH = %.1f percent\n\n",rh); /* prints initial relative humidity */ time = 3600*put.time; /* sets amount of timesteps to run model */ /* Configure PETSc TS solver */ /*------------------------------------------*/ /* Create grid */ ierr = DMDACreate2d(PETSC_COMM_WORLD,DMDA_BOUNDARY_PERIODIC,DMDA_BOUNDARY_PERIODIC,DMDA_STENCIL_STAR,-20,-20, PETSC_DECIDE,PETSC_DECIDE,dof,1,NULL,NULL,&da);CHKERRQ(ierr); ierr = DMDASetUniformCoordinates(da, 0.0, 1.0, 0.0, 1.0, 0.0, 1.0);CHKERRQ(ierr); /* Define output window for each variable of interest */ ierr = DMDASetFieldName(da,0,"Ts");CHKERRQ(ierr); ierr = DMDASetFieldName(da,1,"Ta");CHKERRQ(ierr); ierr = DMDASetFieldName(da,2,"u");CHKERRQ(ierr); ierr = DMDASetFieldName(da,3,"v");CHKERRQ(ierr); ierr = DMDASetFieldName(da,4,"p");CHKERRQ(ierr); /* set values for appctx */ user.da = da; user.Ts = sfctemp; user.fract = put.fr; /* fraction of sky covered by clouds */ user.dewtemp = dewtemp; /* dew point temperature (mositure in air) */ user.csoil = 2000000; /* heat constant for layer */ user.dzlay = 0.08; /* thickness of top soil layer */ user.emma = emma; /* emission parameter */ user.wind = put.wnd; /* wind spped */ user.pressure1 = pressure1; /* sea level pressure */ user.airtemp = airtemp; /* temperature of air near boundar layer inversion */ user.Tc = cloudTemp; /* temperature at base of lowest cloud layer */ user.init = put.init; /* user chosen initiation scenario */ user.lat = 70*0.0174532; /* converts latitude degrees to latitude in radians */ user.deep_grnd_temp = deep_grnd_temp; /* temp in lowest ground layer */ /* set values for MonitorCtx */ usermonitor.drawcontours = PETSC_FALSE; ierr = PetscOptionsHasName(NULL,"-drawcontours",&usermonitor.drawcontours);CHKERRQ(ierr); if (usermonitor.drawcontours) { PetscReal bounds[] = {1000.0,-1000., -1000.,-1000., 1000.,-1000., 1000.,-1000., 1000,-1000, 100700,100800}; ierr = PetscViewerDrawOpen(PETSC_COMM_WORLD,0,0,0,0,300,300,&usermonitor.drawviewer);CHKERRQ(ierr); ierr = PetscViewerDrawSetBounds(usermonitor.drawviewer,dof,bounds);CHKERRQ(ierr); } usermonitor.interval = 1; ierr = PetscOptionsGetInt(NULL,"-monitor_interval",&usermonitor.interval,NULL);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Extract global vectors from DA; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = DMCreateGlobalVector(da,&T);CHKERRQ(ierr); ierr = VecDuplicate(T,&rhs);CHKERRQ(ierr); /* r: vector to put the computed right hand side */ ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr); ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr); ierr = TSSetType(ts,TSBEULER);CHKERRQ(ierr); ierr = TSSetRHSFunction(ts,rhs,RhsFunc,&user);CHKERRQ(ierr); /* Set Jacobian evaluation routine - use coloring to compute finite difference Jacobian efficiently */ ierr = DMSetMatType(da,MATAIJ);CHKERRQ(ierr); ierr = DMCreateMatrix(da,&J);CHKERRQ(ierr); ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr); if (use_coloring) { ISColoring iscoloring; ierr = DMCreateColoring(da,IS_COLORING_GLOBAL,&iscoloring);CHKERRQ(ierr); ierr = MatFDColoringCreate(J,iscoloring,&matfdcoloring);CHKERRQ(ierr); ierr = MatFDColoringSetFromOptions(matfdcoloring);CHKERRQ(ierr); ierr = MatFDColoringSetUp(J,iscoloring,matfdcoloring);CHKERRQ(ierr); ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr); ierr = MatFDColoringSetFunction(matfdcoloring,(PetscErrorCode (*)(void))SNESTSFormFunction,ts);CHKERRQ(ierr); ierr = SNESSetJacobian(snes,J,J,SNESComputeJacobianDefaultColor,matfdcoloring);CHKERRQ(ierr); } else { ierr = SNESSetJacobian(snes,J,J,SNESComputeJacobianDefault,NULL);CHKERRQ(ierr); } /* Define what to print for ts_monitor option */ ierr = PetscOptionsHasName(NULL,"-monitor_off",&monitor_off);CHKERRQ(ierr); if (!monitor_off) { ierr = TSMonitorSet(ts,Monitor,&usermonitor,NULL);CHKERRQ(ierr); } ierr = FormInitialSolution(da,T,&user);CHKERRQ(ierr); dt = TIMESTEP; /* initial time step */ ftime = TIMESTEP*time; if (!rank) printf("time %d, ftime %g hour, TIMESTEP %g\n",time,ftime/3600,dt); ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr); ierr = TSSetDuration(ts,time,ftime);CHKERRQ(ierr); ierr = TSSetSolution(ts,T);CHKERRQ(ierr); ierr = TSSetDM(ts,da);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set runtime options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetFromOptions(ts);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Solve nonlinear system - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSolve(ts,T);CHKERRQ(ierr); ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr); ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr); if (!rank) PetscPrintf(PETSC_COMM_WORLD,"Solution T after %g hours %d steps\n",ftime/3600,steps); if (matfdcoloring) {ierr = MatFDColoringDestroy(&matfdcoloring);CHKERRQ(ierr);} if (usermonitor.drawcontours) { ierr = PetscViewerDestroy(&usermonitor.drawviewer);CHKERRQ(ierr); } ierr = MatDestroy(&J);CHKERRQ(ierr); ierr = VecDestroy(&T);CHKERRQ(ierr); ierr = VecDestroy(&rhs);CHKERRQ(ierr); ierr = TSDestroy(&ts);CHKERRQ(ierr); ierr = DMDestroy(&da);CHKERRQ(ierr); PetscFinalize(); return 0; }
int main(int argc,char **argv) { PetscInt i,M = 3,N = 5,P=3,s=1,w=2,m = PETSC_DECIDE,n = PETSC_DECIDE,p = PETSC_DECIDE; PetscErrorCode ierr; PetscInt *lx = NULL,*ly = NULL,*lz = NULL; DM da; PetscBool flg = PETSC_FALSE,test_order = PETSC_FALSE; ISColoring coloring; Mat mat; DMDAStencilType stencil_type = DMDA_STENCIL_BOX; Vec lvec,dvec; MatFDColoring fdcoloring; ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr); /* Read options */ ierr = PetscOptionsGetInt(NULL,"-M",&M,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,"-N",&N,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,"-P",&P,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,"-m",&m,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,"-p",&p,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,"-s",&s,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,"-w",&w,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetBool(NULL,"-star",&flg,NULL);CHKERRQ(ierr); if (flg) stencil_type = DMDA_STENCIL_STAR; ierr = PetscOptionsGetBool(NULL,"-test_order",&test_order,NULL);CHKERRQ(ierr); flg = PETSC_FALSE; ierr = PetscOptionsGetBool(NULL,"-distribute",&flg,NULL);CHKERRQ(ierr); if (flg) { if (m == PETSC_DECIDE) SETERRQ(PETSC_COMM_WORLD,1,"Must set -m option with -distribute option"); ierr = PetscMalloc1(m,&lx);CHKERRQ(ierr); for (i=0; i<m-1; i++) lx[i] = 4; lx[m-1] = M - 4*(m-1); if (n == PETSC_DECIDE) SETERRQ(PETSC_COMM_WORLD,1,"Must set -n option with -distribute option"); ierr = PetscMalloc1(n,&ly);CHKERRQ(ierr); for (i=0; i<n-1; i++) ly[i] = 2; ly[n-1] = N - 2*(n-1); if (p == PETSC_DECIDE) SETERRQ(PETSC_COMM_WORLD,1,"Must set -p option with -distribute option"); ierr = PetscMalloc1(p,&lz);CHKERRQ(ierr); for (i=0; i<p-1; i++) lz[i] = 2; lz[p-1] = P - 2*(p-1); } /* Create distributed array and get vectors */ ierr = DMDACreate3d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,DM_BOUNDARY_NONE,DM_BOUNDARY_NONE,stencil_type,M,N,P,m,n,p,w,s,lx,ly,lz,&da);CHKERRQ(ierr); ierr = PetscFree(lx);CHKERRQ(ierr); ierr = PetscFree(ly);CHKERRQ(ierr); ierr = PetscFree(lz);CHKERRQ(ierr); ierr = DMSetMatType(da,MATMPIAIJ);CHKERRQ(ierr); ierr = DMCreateColoring(da,IS_COLORING_GLOBAL,&coloring);CHKERRQ(ierr); ierr = DMSetMatType(da,MATMPIAIJ);CHKERRQ(ierr); ierr = DMCreateMatrix(da,&mat);CHKERRQ(ierr); ierr = MatFDColoringCreate(mat,coloring,&fdcoloring);CHKERRQ(ierr); ierr = MatFDColoringSetUp(mat,coloring,fdcoloring);CHKERRQ(ierr); ierr = DMCreateGlobalVector(da,&dvec);CHKERRQ(ierr); ierr = DMCreateLocalVector(da,&lvec);CHKERRQ(ierr); /* Free memory */ ierr = MatFDColoringDestroy(&fdcoloring);CHKERRQ(ierr); ierr = VecDestroy(&dvec);CHKERRQ(ierr); ierr = VecDestroy(&lvec);CHKERRQ(ierr); ierr = MatDestroy(&mat);CHKERRQ(ierr); ierr = ISColoringDestroy(&coloring);CHKERRQ(ierr); ierr = DMDestroy(&da);CHKERRQ(ierr); ierr = PetscFinalize(); return 0; }
int main(int argc,char **argv) { TS ts; /* nonlinear solver */ Vec x,r; /* solution, residual vectors */ Mat J; /* Jacobian matrix */ PetscInt steps,Mx,maxsteps = 10000000; PetscErrorCode ierr; DM da; MatFDColoring matfdcoloring; ISColoring iscoloring; PetscReal dt; PetscReal vbounds[] = {-100000,100000,-1.1,1.1}; PetscBool wait; Vec ul,uh; SNES snes; UserCtx ctx; /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Initialize program - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr; ctx.kappa = 1.0; ierr = PetscOptionsGetReal(NULL,"-kappa",&ctx.kappa,NULL);CHKERRQ(ierr); ctx.cahnhillard = PETSC_FALSE; ierr = PetscOptionsGetBool(NULL,NULL,"-cahn-hillard",&ctx.cahnhillard,NULL);CHKERRQ(ierr); ierr = PetscViewerDrawSetBounds(PETSC_VIEWER_DRAW_(PETSC_COMM_WORLD),2,vbounds);CHKERRQ(ierr); ierr = PetscViewerDrawResize(PETSC_VIEWER_DRAW_(PETSC_COMM_WORLD),600,600);CHKERRQ(ierr); ctx.energy = 1; /* ierr = PetscOptionsGetInt(NULL,NULL,"-energy",&ctx.energy,NULL);CHKERRQ(ierr); */ ierr = PetscOptionsGetInt(NULL,NULL,"-energy",&ctx.energy,NULL);CHKERRQ(ierr); ctx.tol = 1.0e-8; ierr = PetscOptionsGetReal(NULL,"-tol",&ctx.tol,NULL);CHKERRQ(ierr); ctx.theta = .001; ctx.theta_c = 1.0; ierr = PetscOptionsGetReal(NULL,"-theta",&ctx.theta,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetReal(NULL,"-theta_c",&ctx.theta_c,NULL);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create distributed array (DMDA) to manage parallel grid and vectors - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = DMDACreate1d(PETSC_COMM_WORLD, DM_BOUNDARY_PERIODIC, -10,2,2,NULL,&da);CHKERRQ(ierr); ierr = DMSetFromOptions(da);CHKERRQ(ierr); ierr = DMSetUp(da);CHKERRQ(ierr); ierr = DMDASetFieldName(da,0,"Biharmonic heat equation: w = -kappa*u_xx");CHKERRQ(ierr); ierr = DMDASetFieldName(da,1,"Biharmonic heat equation: u");CHKERRQ(ierr); ierr = DMDAGetInfo(da,0,&Mx,0,0,0,0,0,0,0,0,0,0,0);CHKERRQ(ierr); dt = 1.0/(10.*ctx.kappa*Mx*Mx*Mx*Mx); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Extract global vectors from DMDA; then duplicate for remaining vectors that are the same types - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = DMCreateGlobalVector(da,&x);CHKERRQ(ierr); ierr = VecDuplicate(x,&r);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create timestepping solver context - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr); ierr = TSSetDM(ts,da);CHKERRQ(ierr); ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr); ierr = TSSetIFunction(ts,NULL,FormFunction,&ctx);CHKERRQ(ierr); ierr = TSSetDuration(ts,maxsteps,.02);CHKERRQ(ierr); ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create matrix data structure; set Jacobian evaluation routine < Set Jacobian matrix data structure and default Jacobian evaluation routine. User can override with: -snes_mf : matrix-free Newton-Krylov method with no preconditioning (unless user explicitly sets preconditioner) -snes_mf_operator : form preconditioning matrix as set by the user, but use matrix-free approx for Jacobian-vector products within Newton-Krylov method - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr); ierr = DMCreateColoring(da,IS_COLORING_GLOBAL,&iscoloring);CHKERRQ(ierr); ierr = DMSetMatType(da,MATAIJ);CHKERRQ(ierr); ierr = DMCreateMatrix(da,&J);CHKERRQ(ierr); ierr = MatFDColoringCreate(J,iscoloring,&matfdcoloring);CHKERRQ(ierr); ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr); ierr = MatFDColoringSetFunction(matfdcoloring,(PetscErrorCode (*)(void))SNESTSFormFunction,ts);CHKERRQ(ierr); ierr = MatFDColoringSetFromOptions(matfdcoloring);CHKERRQ(ierr); ierr = MatFDColoringSetUp(J,iscoloring,matfdcoloring);CHKERRQ(ierr); ierr = SNESSetJacobian(snes,J,J,SNESComputeJacobianDefaultColor,matfdcoloring);CHKERRQ(ierr); { ierr = VecDuplicate(x,&ul);CHKERRQ(ierr); ierr = VecDuplicate(x,&uh);CHKERRQ(ierr); ierr = VecStrideSet(ul,0,PETSC_NINFINITY);CHKERRQ(ierr); ierr = VecStrideSet(ul,1,-1.0);CHKERRQ(ierr); ierr = VecStrideSet(uh,0,PETSC_INFINITY);CHKERRQ(ierr); ierr = VecStrideSet(uh,1,1.0);CHKERRQ(ierr); ierr = TSVISetVariableBounds(ts,ul,uh);CHKERRQ(ierr); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Customize nonlinear solver - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetType(ts,TSBEULER);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set initial conditions - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = FormInitialSolution(da,x,ctx.kappa);CHKERRQ(ierr); ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr); ierr = TSSetSolution(ts,x);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set runtime options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetFromOptions(ts);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Solve nonlinear system - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSolve(ts,x);CHKERRQ(ierr); wait = PETSC_FALSE; ierr = PetscOptionsGetBool(NULL,NULL,"-wait",&wait,NULL);CHKERRQ(ierr); if (wait) { ierr = PetscSleep(-1);CHKERRQ(ierr); } ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Free work space. All PETSc objects should be destroyed when they are no longer needed. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ { ierr = VecDestroy(&ul);CHKERRQ(ierr); ierr = VecDestroy(&uh);CHKERRQ(ierr); } ierr = MatDestroy(&J);CHKERRQ(ierr); ierr = MatFDColoringDestroy(&matfdcoloring);CHKERRQ(ierr); ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = VecDestroy(&r);CHKERRQ(ierr); ierr = TSDestroy(&ts);CHKERRQ(ierr); ierr = DMDestroy(&da);CHKERRQ(ierr); ierr = PetscFinalize(); PetscFunctionReturn(0); }
int main(int argc,char **argv) { TS ts; /* nonlinear solver */ Vec u; /* solution, residual vectors */ Mat J; /* Jacobian matrix */ PetscInt steps,maxsteps = 1000; /* iterations for convergence */ PetscErrorCode ierr; DM da; MatFDColoring matfdcoloring = PETSC_NULL; PetscReal ftime,dt; MonitorCtx usermonitor; /* user-defined monitor context */ AppCtx user; /* user-defined work context */ JacobianType jacType; PetscInitialize(&argc,&argv,(char *)0,help); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create distributed array (DMDA) to manage parallel grid and vectors - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = DMDACreate1d(PETSC_COMM_WORLD,DMDA_BOUNDARY_NONE,-11,1,1,PETSC_NULL,&da);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Extract global vectors from DMDA; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = DMCreateGlobalVector(da,&u);CHKERRQ(ierr); /* Initialize user application context */ user.c = -30.0; user.boundary = 0; /* 0: Dirichlet BC; 1: Neumann BC */ user.viewJacobian = PETSC_FALSE; ierr = PetscOptionsGetInt(PETSC_NULL,"-boundary",&user.boundary,PETSC_NULL);CHKERRQ(ierr); ierr = PetscOptionsHasName(PETSC_NULL,"-viewJacobian",&user.viewJacobian);CHKERRQ(ierr); usermonitor.drawcontours = PETSC_FALSE; ierr = PetscOptionsHasName(PETSC_NULL,"-drawcontours",&usermonitor.drawcontours);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create timestepping solver context - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr); ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr); ierr = TSSetType(ts,TSTHETA);CHKERRQ(ierr); ierr = TSThetaSetTheta(ts,1.0);CHKERRQ(ierr); /* Make the Theta method behave like backward Euler */ ierr = TSSetIFunction(ts,PETSC_NULL,FormIFunction,&user);CHKERRQ(ierr); ierr = DMCreateMatrix(da,MATAIJ,&J);CHKERRQ(ierr); jacType = JACOBIAN_ANALYTIC; /* use user-provide Jacobian */ ierr = TSSetIJacobian(ts,J,J,FormIJacobian,&user);CHKERRQ(ierr); ierr = TSSetDM(ts,da);CHKERRQ(ierr); /* Use TSGetDM() to access. Setting here allows easy use of geometric multigrid. */ ftime = 1.0; ierr = TSSetDuration(ts,maxsteps,ftime);CHKERRQ(ierr); ierr = TSMonitorSet(ts,MyTSMonitor,&usermonitor,PETSC_NULL);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set initial conditions - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = FormInitialSolution(ts,u,&user);CHKERRQ(ierr); ierr = TSSetSolution(ts,u);CHKERRQ(ierr); dt = .01; ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set runtime options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetFromOptions(ts);CHKERRQ(ierr); /* Use slow fd Jacobian or fast fd Jacobian with colorings. Note: this requirs snes which is not created until TSSetUp()/TSSetFromOptions() is called */ ierr = PetscOptionsBegin(((PetscObject)da)->comm,PETSC_NULL,"Options for Jacobian evaluation",PETSC_NULL);CHKERRQ(ierr); ierr = PetscOptionsEnum("-jac_type","Type of Jacobian","",JacobianTypes,(PetscEnum)jacType,(PetscEnum*)&jacType,0);CHKERRQ(ierr); ierr = PetscOptionsEnd();CHKERRQ(ierr); if (jacType == JACOBIAN_FD_COLORING) { SNES snes; ISColoring iscoloring; ierr = DMCreateColoring(da,IS_COLORING_GLOBAL,MATAIJ,&iscoloring);CHKERRQ(ierr); ierr = MatFDColoringCreate(J,iscoloring,&matfdcoloring);CHKERRQ(ierr); ierr = MatFDColoringSetFromOptions(matfdcoloring);CHKERRQ(ierr); ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr); ierr = MatFDColoringSetFunction(matfdcoloring,(PetscErrorCode(*)(void))SNESTSFormFunction,ts);CHKERRQ(ierr); ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr); ierr = SNESSetJacobian(snes,J,J,SNESDefaultComputeJacobianColor,matfdcoloring);CHKERRQ(ierr); } else if (jacType == JACOBIAN_FD_FULL){ SNES snes; ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr); ierr = SNESSetJacobian(snes,J,J,SNESDefaultComputeJacobian,&user);CHKERRQ(ierr); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Solve nonlinear system - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSolve(ts,u,&ftime);CHKERRQ(ierr); ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Free work space. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = MatDestroy(&J);CHKERRQ(ierr); if (matfdcoloring) {ierr = MatFDColoringDestroy(&matfdcoloring);CHKERRQ(ierr);} ierr = VecDestroy(&u);CHKERRQ(ierr); ierr = TSDestroy(&ts);CHKERRQ(ierr); ierr = DMDestroy(&da);CHKERRQ(ierr); ierr = PetscFinalize(); PetscFunctionReturn(0); }
static PetscErrorCode SNESComputeJacobian_DMDA(SNES snes,Vec X,Mat *A,Mat *B,MatStructure *mstr,void *ctx) { PetscErrorCode ierr; DM dm; DMSNES_DA *dmdasnes = (DMSNES_DA*)ctx; DMDALocalInfo info; Vec Xloc; void *x; PetscFunctionBegin; if (!dmdasnes->residuallocal) SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_PLIB,"Corrupt context"); ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr); if (dmdasnes->jacobianlocal) { ierr = DMGetLocalVector(dm,&Xloc);CHKERRQ(ierr); ierr = DMGlobalToLocalBegin(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr); ierr = DMGlobalToLocalEnd(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr); ierr = DMDAGetLocalInfo(dm,&info);CHKERRQ(ierr); ierr = DMDAVecGetArray(dm,Xloc,&x);CHKERRQ(ierr); CHKMEMQ; ierr = (*dmdasnes->jacobianlocal)(&info,x,*A,*B,mstr,dmdasnes->jacobianlocalctx);CHKERRQ(ierr); CHKMEMQ; ierr = DMDAVecRestoreArray(dm,Xloc,&x);CHKERRQ(ierr); ierr = DMRestoreLocalVector(dm,&Xloc);CHKERRQ(ierr); } else { MatFDColoring fdcoloring; ierr = PetscObjectQuery((PetscObject)dm,"DMDASNES_FDCOLORING",(PetscObject*)&fdcoloring);CHKERRQ(ierr); if (!fdcoloring) { ISColoring coloring; ierr = DMCreateColoring(dm,dm->coloringtype,&coloring);CHKERRQ(ierr); ierr = MatFDColoringCreate(*B,coloring,&fdcoloring);CHKERRQ(ierr); ierr = ISColoringDestroy(&coloring);CHKERRQ(ierr); switch (dm->coloringtype) { case IS_COLORING_GLOBAL: ierr = MatFDColoringSetFunction(fdcoloring,(PetscErrorCode (*)(void))SNESComputeFunction_DMDA,dmdasnes);CHKERRQ(ierr); break; default: SETERRQ1(PetscObjectComm((PetscObject)snes),PETSC_ERR_SUP,"No support for coloring type '%s'",ISColoringTypes[dm->coloringtype]); } ierr = PetscObjectSetOptionsPrefix((PetscObject)fdcoloring,((PetscObject)dm)->prefix);CHKERRQ(ierr); ierr = MatFDColoringSetFromOptions(fdcoloring);CHKERRQ(ierr); ierr = PetscObjectCompose((PetscObject)dm,"DMDASNES_FDCOLORING",(PetscObject)fdcoloring);CHKERRQ(ierr); ierr = PetscObjectDereference((PetscObject)fdcoloring);CHKERRQ(ierr); /* The following breaks an ugly reference counting loop that deserves a paragraph. MatFDColoringApply() will call * VecDuplicate() with the state Vec and store inside the MatFDColoring. This Vec will duplicate the Vec, but the * MatFDColoring is composed with the DM. We dereference the DM here so that the reference count will eventually * drop to 0. Note the code in DMDestroy() that exits early for a negative reference count. That code path will be * taken when the PetscObjectList for the Vec inside MatFDColoring is destroyed. */ ierr = PetscObjectDereference((PetscObject)dm);CHKERRQ(ierr); } *mstr = SAME_NONZERO_PATTERN; ierr = MatFDColoringApply(*B,fdcoloring,X,mstr,snes);CHKERRQ(ierr); } /* This will be redundant if the user called both, but it's too common to forget. */ if (*A != *B) { ierr = MatAssemblyBegin(*A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(*A,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); }