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); }
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) { PetscErrorCode ierr; PetscInt time_steps=100,iout,NOUT=1; PetscMPIInt size; Vec global; PetscReal dt,ftime,ftime_original; TS ts; PetscViewer viewfile; Mat J = 0; Vec x; Data data; PetscInt mn; PetscBool flg; MatColoring mc; ISColoring iscoloring; MatFDColoring matfdcoloring = 0; PetscBool fd_jacobian_coloring = PETSC_FALSE; SNES snes; KSP ksp; PC pc; PetscViewer viewer; char pcinfo[120],tsinfo[120]; TSType tstype; PetscBool sundials; ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr); ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); /* set data */ data.m = 9; data.n = 9; data.a = 1.0; data.epsilon = 0.1; data.dx = 1.0/(data.m+1.0); data.dy = 1.0/(data.n+1.0); mn = (data.m)*(data.n); ierr = PetscOptionsGetInt(NULL,"-time",&time_steps,NULL);CHKERRQ(ierr); /* set initial conditions */ ierr = VecCreate(PETSC_COMM_WORLD,&global);CHKERRQ(ierr); ierr = VecSetSizes(global,PETSC_DECIDE,mn);CHKERRQ(ierr); ierr = VecSetFromOptions(global);CHKERRQ(ierr); ierr = Initial(global,&data);CHKERRQ(ierr); ierr = VecDuplicate(global,&x);CHKERRQ(ierr); /* create timestep context */ ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr); ierr = TSMonitorSet(ts,Monitor,&data,NULL);CHKERRQ(ierr); #if defined(PETSC_HAVE_SUNDIALS) ierr = TSSetType(ts,TSSUNDIALS);CHKERRQ(ierr); #else ierr = TSSetType(ts,TSEULER);CHKERRQ(ierr); #endif dt = 0.1; ftime_original = data.tfinal = 1.0; ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr); ierr = TSSetDuration(ts,time_steps,ftime_original);CHKERRQ(ierr); ierr = TSSetSolution(ts,global);CHKERRQ(ierr); /* set user provided RHSFunction and RHSJacobian */ ierr = TSSetRHSFunction(ts,NULL,RHSFunction,&data);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_WORLD,&J);CHKERRQ(ierr); ierr = MatSetSizes(J,PETSC_DECIDE,PETSC_DECIDE,mn,mn);CHKERRQ(ierr); ierr = MatSetFromOptions(J);CHKERRQ(ierr); ierr = MatSeqAIJSetPreallocation(J,5,NULL);CHKERRQ(ierr); ierr = MatMPIAIJSetPreallocation(J,5,NULL,5,NULL);CHKERRQ(ierr); ierr = PetscOptionsHasName(NULL,"-ts_fd",&flg);CHKERRQ(ierr); if (!flg) { ierr = TSSetRHSJacobian(ts,J,J,RHSJacobian,&data);CHKERRQ(ierr); } else { ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr); ierr = PetscOptionsHasName(NULL,"-fd_color",&fd_jacobian_coloring);CHKERRQ(ierr); if (fd_jacobian_coloring) { /* Use finite differences with coloring */ /* Get data structure of J */ PetscBool pc_diagonal; ierr = PetscOptionsHasName(NULL,"-pc_diagonal",&pc_diagonal);CHKERRQ(ierr); if (pc_diagonal) { /* the preconditioner of J is a diagonal matrix */ PetscInt rstart,rend,i; PetscScalar zero=0.0; ierr = MatGetOwnershipRange(J,&rstart,&rend);CHKERRQ(ierr); for (i=rstart; i<rend; i++) { ierr = MatSetValues(J,1,&i,1,&i,&zero,INSERT_VALUES);CHKERRQ(ierr); } ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); } else { /* Fill the structure using the expensive SNESComputeJacobianDefault. Temporarily set up the TS so we can call this function */ ierr = TSSetType(ts,TSBEULER);CHKERRQ(ierr); ierr = TSSetUp(ts);CHKERRQ(ierr); ierr = SNESComputeJacobianDefault(snes,x,J,J,ts);CHKERRQ(ierr); } /* create coloring context */ ierr = MatColoringCreate(J,&mc);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(J,iscoloring,&matfdcoloring);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 = ISColoringDestroy(&iscoloring);CHKERRQ(ierr); } else { /* Use finite differences (slow) */ ierr = SNESSetJacobian(snes,J,J,SNESComputeJacobianDefault,NULL);CHKERRQ(ierr); } } /* Pick up a Petsc preconditioner */ /* one can always set method or preconditioner during the run time */ ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr); ierr = SNESGetKSP(snes,&ksp);CHKERRQ(ierr); ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr); ierr = PCSetType(pc,PCJACOBI);CHKERRQ(ierr); ierr = TSSetFromOptions(ts);CHKERRQ(ierr); ierr = TSSetUp(ts);CHKERRQ(ierr); /* Test TSSetPostStep() */ ierr = PetscOptionsHasName(NULL,"-test_PostStep",&flg);CHKERRQ(ierr); if (flg) { ierr = TSSetPostStep(ts,PostStep);CHKERRQ(ierr); } ierr = PetscOptionsGetInt(NULL,"-NOUT",&NOUT,NULL);CHKERRQ(ierr); for (iout=1; iout<=NOUT; iout++) { ierr = TSSetDuration(ts,time_steps,iout*ftime_original/NOUT);CHKERRQ(ierr); ierr = TSSolve(ts,global);CHKERRQ(ierr); ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr); ierr = TSSetInitialTimeStep(ts,ftime,dt);CHKERRQ(ierr); } /* Interpolate solution at tfinal */ ierr = TSGetSolution(ts,&global);CHKERRQ(ierr); ierr = TSInterpolate(ts,ftime_original,global);CHKERRQ(ierr); ierr = PetscOptionsHasName(NULL,"-matlab_view",&flg);CHKERRQ(ierr); if (flg) { /* print solution into a MATLAB file */ ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,"out.m",&viewfile);CHKERRQ(ierr); ierr = PetscViewerSetFormat(viewfile,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr); ierr = VecView(global,viewfile);CHKERRQ(ierr); ierr = PetscViewerDestroy(&viewfile);CHKERRQ(ierr); } /* display solver info for Sundials */ ierr = TSGetType(ts,&tstype);CHKERRQ(ierr); ierr = PetscObjectTypeCompare((PetscObject)ts,TSSUNDIALS,&sundials);CHKERRQ(ierr); if (sundials) { ierr = PetscViewerStringOpen(PETSC_COMM_WORLD,tsinfo,120,&viewer);CHKERRQ(ierr); ierr = TSView(ts,viewer);CHKERRQ(ierr); ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); ierr = PetscViewerStringOpen(PETSC_COMM_WORLD,pcinfo,120,&viewer);CHKERRQ(ierr); ierr = PCView(pc,viewer);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"%d Procs,%s TSType, %s Preconditioner\n",size,tsinfo,pcinfo);CHKERRQ(ierr); ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); } /* free the memories */ ierr = TSDestroy(&ts);CHKERRQ(ierr); ierr = VecDestroy(&global);CHKERRQ(ierr); ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = MatDestroy(&J);CHKERRQ(ierr); if (fd_jacobian_coloring) {ierr = MatFDColoringDestroy(&matfdcoloring);CHKERRQ(ierr);} ierr = PetscFinalize(); return 0; }
void NonlinearSystem::setupColoringFiniteDifferencedPreconditioner() { #ifdef LIBMESH_HAVE_PETSC // Make sure that libMesh isn't going to override our preconditioner _transient_sys.nonlinear_solver->jacobian = nullptr; PetscNonlinearSolver<Number> & petsc_nonlinear_solver = dynamic_cast<PetscNonlinearSolver<Number> &>(*_transient_sys.nonlinear_solver); // Pointer to underlying PetscMatrix type PetscMatrix<Number> * petsc_mat = dynamic_cast<PetscMatrix<Number> *>(_transient_sys.matrix); #if PETSC_VERSION_LESS_THAN(3, 2, 0) // This variable is only needed for PETSC < 3.2.0 PetscVector<Number> * petsc_vec = dynamic_cast<PetscVector<Number> *>(_transient_sys.solution.get()); #endif Moose::compute_jacobian(*_transient_sys.current_local_solution, *petsc_mat, _transient_sys); if (!petsc_mat) mooseError("Could not convert to Petsc matrix."); petsc_mat->close(); PetscErrorCode ierr = 0; ISColoring iscoloring; #if PETSC_VERSION_LESS_THAN(3, 2, 0) // PETSc 3.2.x ierr = MatGetColoring(petsc_mat->mat(), MATCOLORING_LF, &iscoloring); CHKERRABORT(libMesh::COMM_WORLD, ierr); #elif PETSC_VERSION_LESS_THAN(3, 5, 0) // PETSc 3.3.x, 3.4.x ierr = MatGetColoring(petsc_mat->mat(), MATCOLORINGLF, &iscoloring); CHKERRABORT(_communicator.get(), ierr); #else // PETSc 3.5.x MatColoring matcoloring; ierr = MatColoringCreate(petsc_mat->mat(), &matcoloring); CHKERRABORT(_communicator.get(), ierr); ierr = MatColoringSetType(matcoloring, MATCOLORINGLF); CHKERRABORT(_communicator.get(), ierr); ierr = MatColoringSetFromOptions(matcoloring); CHKERRABORT(_communicator.get(), ierr); ierr = MatColoringApply(matcoloring, &iscoloring); CHKERRABORT(_communicator.get(), ierr); ierr = MatColoringDestroy(&matcoloring); CHKERRABORT(_communicator.get(), ierr); #endif MatFDColoringCreate(petsc_mat->mat(), iscoloring, &_fdcoloring); MatFDColoringSetFromOptions(_fdcoloring); MatFDColoringSetFunction(_fdcoloring, (PetscErrorCode(*)(void)) & libMesh::__libmesh_petsc_snes_fd_residual, &petsc_nonlinear_solver); #if !PETSC_RELEASE_LESS_THAN(3, 5, 0) MatFDColoringSetUp(petsc_mat->mat(), iscoloring, _fdcoloring); #endif #if PETSC_VERSION_LESS_THAN(3, 4, 0) SNESSetJacobian(petsc_nonlinear_solver.snes(), petsc_mat->mat(), petsc_mat->mat(), SNESDefaultComputeJacobianColor, _fdcoloring); #else SNESSetJacobian(petsc_nonlinear_solver.snes(), petsc_mat->mat(), petsc_mat->mat(), SNESComputeJacobianDefaultColor, _fdcoloring); #endif #if PETSC_VERSION_LESS_THAN(3, 2, 0) Mat my_mat = petsc_mat->mat(); MatStructure my_struct; SNESComputeJacobian( petsc_nonlinear_solver.snes(), petsc_vec->vec(), &my_mat, &my_mat, &my_struct); #endif #if PETSC_VERSION_LESS_THAN(3, 2, 0) ISColoringDestroy(iscoloring); #else // PETSc 3.3.0 ISColoringDestroy(&iscoloring); #endif #endif }
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); }