/* FormFunctionGradient - Evaluates the function and corresponding gradient. Input Parameters: tao - the Tao context X - the input vector ptr - optional user-defined context, as set by TaoSetObjectiveAndGradientRoutine() Output Parameters: f - the newly evaluated function G - the newly evaluated gradient */ PetscErrorCode FormFunctionGradient(Tao tao,Vec IC,PetscReal *f,Vec G,void *ctx) { User user_ptr = (User)ctx; TS ts; PetscScalar *x_ptr,*y_ptr; PetscErrorCode ierr; ierr = VecCopy(IC,user_ptr->x);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create timestepping solver context - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr); ierr = TSSetType(ts,TSCN);CHKERRQ(ierr); ierr = TSSetIFunction(ts,NULL,IFunction,user_ptr);CHKERRQ(ierr); ierr = TSSetIJacobian(ts,user_ptr->A,user_ptr->A,IJacobian,user_ptr);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set time - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetTime(ts,0.0);CHKERRQ(ierr); ierr = TSSetDuration(ts,PETSC_DEFAULT,0.5);CHKERRQ(ierr); ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Save trajectory of solution so that TSAdjointSolve() may be used - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set runtime options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetFromOptions(ts);CHKERRQ(ierr); ierr = TSSolve(ts,user_ptr->x);CHKERRQ(ierr); ierr = VecGetArray(user_ptr->x,&x_ptr);CHKERRQ(ierr); *f = (x_ptr[0]-user_ptr->x_ob[0])*(x_ptr[0]-user_ptr->x_ob[0])+(x_ptr[1]-user_ptr->x_ob[1])*(x_ptr[1]-user_ptr->x_ob[1]); ierr = PetscPrintf(PETSC_COMM_WORLD,"Observed value y_ob=[%f; %f], ODE solution y=[%f;%f], Cost function f=%f\n",(double)user_ptr->x_ob[0],(double)user_ptr->x_ob[1],(double)x_ptr[0],(double)x_ptr[1],(double)(*f));CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Adjoint model starts here - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* Redet initial conditions for the adjoint integration */ ierr = VecGetArray(user_ptr->lambda[0],&y_ptr);CHKERRQ(ierr); y_ptr[0] = 2.*(x_ptr[0]-user_ptr->x_ob[0]); y_ptr[1] = 2.*(x_ptr[1]-user_ptr->x_ob[1]); ierr = VecRestoreArray(user_ptr->lambda[0],&y_ptr);CHKERRQ(ierr); ierr = TSSetCostGradients(ts,1,user_ptr->lambda,NULL);CHKERRQ(ierr); ierr = TSAdjointSolve(ts);CHKERRQ(ierr); ierr = VecCopy(user_ptr->lambda[0],G); ierr = TSDestroy(&ts);CHKERRQ(ierr); PetscFunctionReturn(0); }
/* * This is a modified version of PETSc/src/ts/examples/tutorials/ex15.c * to demonstrate how MOOSE interact with an external solver package */ PetscErrorCode externalPETScDiffusionFDMSolve(TS ts, Vec u, PetscReal dt, PetscReal time) { PetscErrorCode ierr; #if !PETSC_VERSION_LESS_THAN(3, 8, 0) PetscInt current_step; #endif DM da; PetscFunctionBeginUser; ierr = TSGetDM(ts, &da); CHKERRQ(ierr); #if !PETSC_VERSION_LESS_THAN(3, 7, 0) PetscOptionsSetValue(NULL, "-ts_monitor", NULL); PetscOptionsSetValue(NULL, "-snes_monitor", NULL); PetscOptionsSetValue(NULL, "-ksp_monitor", NULL); #else PetscOptionsSetValue("-ts_monitor", NULL); PetscOptionsSetValue("-snes_monitor", NULL); PetscOptionsSetValue("-ksp_monitor", NULL); #endif /*ierr = TSSetMaxTime(ts,1.0);CHKERRQ(ierr);*/ ierr = TSSetExactFinalTime(ts, TS_EXACTFINALTIME_STEPOVER); CHKERRQ(ierr); ierr = TSSetSolution(ts, u); CHKERRQ(ierr); ierr = TSSetTimeStep(ts, dt); CHKERRQ(ierr); ierr = TSSetTime(ts, time - dt); CHKERRQ(ierr); #if !PETSC_VERSION_LESS_THAN(3, 8, 0) ierr = TSGetStepNumber(ts, ¤t_step); CHKERRQ(ierr); ierr = TSSetMaxSteps(ts, current_step + 1); CHKERRQ(ierr); #else SETERRQ(PetscObjectComm((PetscObject)ts), PETSC_ERR_SUP, "Require PETSc-3.8.x or higher "); #endif /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Sets various TS parameters from user options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetFromOptions(ts); CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Solve nonlinear system - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSolve(ts, u); CHKERRQ(ierr); PetscFunctionReturn(0); }
PetscErrorCode RunTest(int nx, int ny, int nz, int loops, double *wt) { Vec x,f; TS ts; AppCtx _app,*app=&_app; double t1,t2; PetscErrorCode ierr; PetscFunctionBegin; app->nx = nx; app->h[0] = 1./(nx-1); app->ny = ny; app->h[1] = 1./(ny-1); app->nz = nz; app->h[2] = 1./(nz-1); ierr = VecCreate(PETSC_COMM_SELF,&x);CHKERRQ(ierr); ierr = VecSetSizes(x,nx*ny*nz,nx*ny*nz);CHKERRQ(ierr); ierr = VecSetUp(x);CHKERRQ(ierr); ierr = VecDuplicate(x,&f);CHKERRQ(ierr); ierr = TSCreate(PETSC_COMM_SELF,&ts);CHKERRQ(ierr); ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr); ierr = TSSetType(ts,TSTHETA);CHKERRQ(ierr); ierr = TSThetaSetTheta(ts,1.0);CHKERRQ(ierr); ierr = TSSetTimeStep(ts,0.01);CHKERRQ(ierr); ierr = TSSetTime(ts,0.0);CHKERRQ(ierr); ierr = TSSetDuration(ts,10,1.0);CHKERRQ(ierr); ierr = TSSetSolution(ts,x);CHKERRQ(ierr); ierr = TSSetIFunction(ts,f,FormFunction,app);CHKERRQ(ierr); ierr = PetscOptionsSetValue("-snes_mf","1");CHKERRQ(ierr); { SNES snes; KSP ksp; ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr); ierr = SNESGetKSP(snes,&ksp);CHKERRQ(ierr); ierr = KSPSetType(ksp,KSPCG);CHKERRQ(ierr); } ierr = TSSetFromOptions(ts);CHKERRQ(ierr); ierr = TSSetUp(ts);CHKERRQ(ierr); *wt = 1e300; while (loops-- > 0) { ierr = FormInitial(0.0,x,app);CHKERRQ(ierr); ierr = PetscGetTime(&t1);CHKERRQ(ierr); ierr = TSSolve(ts,x,PETSC_NULL);CHKERRQ(ierr); ierr = PetscGetTime(&t2);CHKERRQ(ierr); *wt = PetscMin(*wt,t2-t1); } ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = VecDestroy(&f);CHKERRQ(ierr); ierr = TSDestroy(&ts);CHKERRQ(ierr); PetscFunctionReturn(0); }
int main(int argc,char **argv) { AppCtx appctx; /* user-defined application context */ PetscErrorCode ierr; PetscInt i, xs, xm, ind, j, lenglob; PetscReal x, *wrk_ptr1, *wrk_ptr2; MatNullSpace nsp; PetscMPIInt size; /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Initialize program and set problem parameters - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ PetscFunctionBegin; ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr; /*initialize parameters */ appctx.param.N = 10; /* order of the spectral element */ appctx.param.E = 10; /* number of elements */ appctx.param.L = 4.0; /* length of the domain */ appctx.param.mu = 0.01; /* diffusion coefficient */ appctx.initial_dt = 5e-3; appctx.param.steps = PETSC_MAX_INT; appctx.param.Tend = 4; ierr = PetscOptionsGetInt(NULL,NULL,"-N",&appctx.param.N,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,NULL,"-E",&appctx.param.E,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetReal(NULL,NULL,"-Tend",&appctx.param.Tend,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetReal(NULL,NULL,"-mu",&appctx.param.mu,NULL);CHKERRQ(ierr); appctx.param.Le = appctx.param.L/appctx.param.E; ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); if (appctx.param.E % size) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_ARG_WRONG,"Number of elements must be divisible by number of processes"); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create GLL data structures - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = PetscGLLCreate(appctx.param.N,PETSCGLL_VIA_LINEARALGEBRA,&appctx.SEMop.gll);CHKERRQ(ierr); lenglob = appctx.param.E*(appctx.param.N-1); /* Create distributed array (DMDA) to manage parallel grid and vectors and to set up the ghost point communication pattern. There are E*(Nl-1)+1 total grid values spread equally among all the processors, except first and last */ ierr = DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_PERIODIC,lenglob,1,1,NULL,&appctx.da);CHKERRQ(ierr); ierr = DMSetFromOptions(appctx.da);CHKERRQ(ierr); ierr = DMSetUp(appctx.da);CHKERRQ(ierr); /* Extract global and local vectors from DMDA; we use these to store the approximate solution. Then duplicate these for remaining vectors that have the same types. */ ierr = DMCreateGlobalVector(appctx.da,&appctx.dat.curr_sol);CHKERRQ(ierr); ierr = VecDuplicate(appctx.dat.curr_sol,&appctx.SEMop.grid);CHKERRQ(ierr); ierr = VecDuplicate(appctx.dat.curr_sol,&appctx.SEMop.mass);CHKERRQ(ierr); ierr = DMDAGetCorners(appctx.da,&xs,NULL,NULL,&xm,NULL,NULL);CHKERRQ(ierr); ierr = DMDAVecGetArray(appctx.da,appctx.SEMop.grid,&wrk_ptr1);CHKERRQ(ierr); ierr = DMDAVecGetArray(appctx.da,appctx.SEMop.mass,&wrk_ptr2);CHKERRQ(ierr); /* Compute function over the locally owned part of the grid */ xs=xs/(appctx.param.N-1); xm=xm/(appctx.param.N-1); /* Build total grid and mass over entire mesh (multi-elemental) */ for (i=xs; i<xs+xm; i++) { for (j=0; j<appctx.param.N-1; j++) { x = (appctx.param.Le/2.0)*(appctx.SEMop.gll.nodes[j]+1.0)+appctx.param.Le*i; ind=i*(appctx.param.N-1)+j; wrk_ptr1[ind]=x; wrk_ptr2[ind]=.5*appctx.param.Le*appctx.SEMop.gll.weights[j]; if (j==0) wrk_ptr2[ind]+=.5*appctx.param.Le*appctx.SEMop.gll.weights[j]; } } ierr = DMDAVecRestoreArray(appctx.da,appctx.SEMop.grid,&wrk_ptr1);CHKERRQ(ierr); ierr = DMDAVecRestoreArray(appctx.da,appctx.SEMop.mass,&wrk_ptr2);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create matrix data structure; set matrix evaluation routine. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = DMSetMatrixPreallocateOnly(appctx.da, PETSC_TRUE);CHKERRQ(ierr); ierr = DMCreateMatrix(appctx.da,&appctx.SEMop.stiff);CHKERRQ(ierr); ierr = DMCreateMatrix(appctx.da,&appctx.SEMop.grad);CHKERRQ(ierr); /* For linear problems with a time-dependent f(u,t) in the equation u_t = f(u,t), the user provides the discretized right-hand-side as a time-dependent matrix. */ ierr = RHSMatrixLaplaciangllDM(appctx.ts,0.0,appctx.dat.curr_sol,appctx.SEMop.stiff,appctx.SEMop.stiff,&appctx);CHKERRQ(ierr); ierr = RHSMatrixAdvectiongllDM(appctx.ts,0.0,appctx.dat.curr_sol,appctx.SEMop.grad,appctx.SEMop.grad,&appctx);CHKERRQ(ierr); /* For linear problems with a time-dependent f(u,t) in the equation u_t = f(u,t), the user provides the discretized right-hand-side as a time-dependent matrix. */ ierr = MatDuplicate(appctx.SEMop.stiff,MAT_COPY_VALUES,&appctx.SEMop.keptstiff);CHKERRQ(ierr); /* attach the null space to the matrix, this probably is not needed but does no harm */ ierr = MatNullSpaceCreate(PETSC_COMM_WORLD,PETSC_TRUE,0,NULL,&nsp);CHKERRQ(ierr); ierr = MatSetNullSpace(appctx.SEMop.stiff,nsp);CHKERRQ(ierr); ierr = MatSetNullSpace(appctx.SEMop.keptstiff,nsp);CHKERRQ(ierr); ierr = MatNullSpaceTest(nsp,appctx.SEMop.stiff,NULL);CHKERRQ(ierr); ierr = MatNullSpaceDestroy(&nsp);CHKERRQ(ierr); /* attach the null space to the matrix, this probably is not needed but does no harm */ ierr = MatNullSpaceCreate(PETSC_COMM_WORLD,PETSC_TRUE,0,NULL,&nsp);CHKERRQ(ierr); ierr = MatSetNullSpace(appctx.SEMop.grad,nsp);CHKERRQ(ierr); ierr = MatNullSpaceTest(nsp,appctx.SEMop.grad,NULL);CHKERRQ(ierr); ierr = MatNullSpaceDestroy(&nsp);CHKERRQ(ierr); /* Create the TS solver that solves the ODE and its adjoint; set its options */ ierr = TSCreate(PETSC_COMM_WORLD,&appctx.ts);CHKERRQ(ierr); ierr = TSSetProblemType(appctx.ts,TS_NONLINEAR);CHKERRQ(ierr); ierr = TSSetType(appctx.ts,TSRK);CHKERRQ(ierr); ierr = TSSetDM(appctx.ts,appctx.da);CHKERRQ(ierr); ierr = TSSetTime(appctx.ts,0.0);CHKERRQ(ierr); ierr = TSSetTimeStep(appctx.ts,appctx.initial_dt);CHKERRQ(ierr); ierr = TSSetMaxSteps(appctx.ts,appctx.param.steps);CHKERRQ(ierr); ierr = TSSetMaxTime(appctx.ts,appctx.param.Tend);CHKERRQ(ierr); ierr = TSSetExactFinalTime(appctx.ts,TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr); ierr = TSSetTolerances(appctx.ts,1e-7,NULL,1e-7,NULL);CHKERRQ(ierr); ierr = TSSetSaveTrajectory(appctx.ts);CHKERRQ(ierr); ierr = TSSetFromOptions(appctx.ts);CHKERRQ(ierr); ierr = TSSetRHSFunction(appctx.ts,NULL,RHSFunction,&appctx);CHKERRQ(ierr); ierr = TSSetRHSJacobian(appctx.ts,appctx.SEMop.stiff,appctx.SEMop.stiff,RHSJacobian,&appctx);CHKERRQ(ierr); /* Set Initial conditions for the problem */ ierr = TrueSolution(appctx.ts,0,appctx.dat.curr_sol,&appctx);CHKERRQ(ierr); ierr = TSSetSolutionFunction(appctx.ts,(PetscErrorCode (*)(TS,PetscReal,Vec,void *))TrueSolution,&appctx);CHKERRQ(ierr); ierr = TSSetTime(appctx.ts,0.0);CHKERRQ(ierr); ierr = TSSetStepNumber(appctx.ts,0);CHKERRQ(ierr); ierr = TSSolve(appctx.ts,appctx.dat.curr_sol);CHKERRQ(ierr); ierr = MatDestroy(&appctx.SEMop.stiff);CHKERRQ(ierr); ierr = MatDestroy(&appctx.SEMop.keptstiff);CHKERRQ(ierr); ierr = MatDestroy(&appctx.SEMop.grad);CHKERRQ(ierr); ierr = VecDestroy(&appctx.SEMop.grid);CHKERRQ(ierr); ierr = VecDestroy(&appctx.SEMop.mass);CHKERRQ(ierr); ierr = VecDestroy(&appctx.dat.curr_sol);CHKERRQ(ierr); ierr = PetscGLLDestroy(&appctx.SEMop.gll);CHKERRQ(ierr); ierr = DMDestroy(&appctx.da);CHKERRQ(ierr); ierr = TSDestroy(&appctx.ts);CHKERRQ(ierr); /* Always call PetscFinalize() before exiting a program. This routine - finalizes the PETSc libraries as well as MPI - provides summary and diagnostic information if certain runtime options are chosen (e.g., -log_summary). */ ierr = PetscFinalize(); return ierr; }
int main(int argc,char **argv) { TS ts; /* nonlinear solver */ Vec ic; PetscBool monitor = PETSC_FALSE; PetscScalar *x_ptr; PetscMPIInt size; struct _n_User user; PetscErrorCode ierr; Tao tao; TaoConvergedReason reason; KSP ksp; PC pc; /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Initialize program - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ PetscInitialize(&argc,&argv,NULL,help); ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); if (size != 1) SETERRQ(PETSC_COMM_SELF,1,"This is a uniprocessor example only!"); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set runtime options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ user.mu = 1.0; user.next_output = 0.0; user.steps = 0; user.ftime = 0.5; ierr = PetscOptionsGetReal(NULL,"-mu",&user.mu,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetBool(NULL,"-monitor",&monitor,NULL);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create necessary matrix and vectors, solve same ODE on every process - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = MatCreate(PETSC_COMM_WORLD,&user.A);CHKERRQ(ierr); ierr = MatSetSizes(user.A,PETSC_DECIDE,PETSC_DECIDE,2,2);CHKERRQ(ierr); ierr = MatSetFromOptions(user.A);CHKERRQ(ierr); ierr = MatSetUp(user.A);CHKERRQ(ierr); ierr = MatCreateVecs(user.A,&user.x,NULL);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create timestepping solver context - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr); ierr = TSSetType(ts,TSRK);CHKERRQ(ierr); ierr = TSSetRHSFunction(ts,NULL,RHSFunction,&user);CHKERRQ(ierr); ierr = TSSetDuration(ts,PETSC_DEFAULT,user.ftime);CHKERRQ(ierr); ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr); if (monitor) { ierr = TSMonitorSet(ts,Monitor,&user,NULL);CHKERRQ(ierr); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set initial conditions - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = VecGetArray(user.x,&x_ptr);CHKERRQ(ierr); x_ptr[0] = 2.0; x_ptr[1] = 0.66666654321; ierr = VecRestoreArray(user.x,&x_ptr);CHKERRQ(ierr); ierr = TSSetTime(ts,0.0);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"mu %g, steps %D, ftime %g\n",(double)user.mu,user.steps,(double)(user.ftime));CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Save trajectory of solution so that TSAdjointSolve() may be used - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set runtime options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetFromOptions(ts);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Solve nonlinear system - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSolve(ts,user.x);CHKERRQ(ierr); ierr = TSGetSolveTime(ts,&(user.ftime));CHKERRQ(ierr); ierr = TSGetTimeStepNumber(ts,&user.steps);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"mu %g, steps %D, ftime %g\n",(double)user.mu,user.steps,(double)user.ftime);CHKERRQ(ierr); ierr = VecGetArray(user.x,&x_ptr);CHKERRQ(ierr); user.x_ob[0] = x_ptr[0]; user.x_ob[1] = x_ptr[1]; ierr = MatCreateVecs(user.A,&user.lambda[0],NULL);CHKERRQ(ierr); /* Create TAO solver and set desired solution method */ ierr = TaoCreate(PETSC_COMM_WORLD,&tao);CHKERRQ(ierr); ierr = TaoSetType(tao,TAOCG);CHKERRQ(ierr); /* Set initial solution guess */ ierr = MatCreateVecs(user.A,&ic,NULL);CHKERRQ(ierr); ierr = VecGetArray(ic,&x_ptr);CHKERRQ(ierr); x_ptr[0] = 2.1; x_ptr[1] = 0.7; ierr = VecRestoreArray(ic,&x_ptr);CHKERRQ(ierr); ierr = TaoSetInitialVector(tao,ic);CHKERRQ(ierr); /* Set routine for function and gradient evaluation */ ierr = TaoSetObjectiveAndGradientRoutine(tao,FormFunctionGradient,(void *)&user);CHKERRQ(ierr); /* Check for any TAO command line options */ ierr = TaoSetFromOptions(tao);CHKERRQ(ierr); ierr = TaoGetKSP(tao,&ksp);CHKERRQ(ierr); if (ksp) { ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr); ierr = PCSetType(pc,PCNONE);CHKERRQ(ierr); } ierr = TaoSetTolerances(tao,1e-10,1e-10,1e-10,PETSC_DEFAULT,PETSC_DEFAULT); /* SOLVE THE APPLICATION */ ierr = TaoSolve(tao); CHKERRQ(ierr); /* Get information on termination */ ierr = TaoGetConvergedReason(tao,&reason);CHKERRQ(ierr); if (reason <= 0){ ierr=PetscPrintf(MPI_COMM_WORLD, "Try another method! \n");CHKERRQ(ierr); } /* Free TAO data structures */ ierr = TaoDestroy(&tao);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Free work space. All PETSc objects should be destroyed when they are no longer needed. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = MatDestroy(&user.A);CHKERRQ(ierr); ierr = VecDestroy(&user.x);CHKERRQ(ierr); ierr = VecDestroy(&user.lambda[0]);CHKERRQ(ierr); ierr = TSDestroy(&ts);CHKERRQ(ierr); ierr = VecDestroy(&ic);CHKERRQ(ierr); ierr = PetscFinalize(); PetscFunctionReturn(0); }
/* * time_step solves for the time_dependence of the system * that was previously setup using the add_to_ham and add_lin * routines. Solver selection and parameters can be controlled via PETSc * command line options. Default solver is TSRK3BS * * Inputs: * Vec x: The density matrix, with appropriate inital conditions * double dt: initial timestep. For certain explicit methods, this timestep * can be changed, as those methods have adaptive time steps * double time_max: the maximum time to integrate to * int steps_max: max number of steps to take */ void time_step(Vec x, PetscReal init_time, PetscReal time_max,PetscReal dt,PetscInt steps_max){ PetscViewer mat_view; TS ts; /* timestepping context */ PetscInt i,j,Istart,Iend,steps,row,col; PetscScalar mat_tmp; PetscReal tmp_real; Mat AA; PetscInt nevents,direction; PetscBool terminate; operator op; int num_pop; double *populations; Mat solve_A,solve_stiff_A; PetscLogStagePop(); PetscLogStagePush(solve_stage); if (_lindblad_terms) { if (nid==0) { printf("Lindblad terms found, using Lindblad solver.\n"); } solve_A = full_A; if (_stiff_solver) { if(nid==0) printf("ERROR! Lindblad-stiff solver untested."); exit(0); } } else { if (nid==0) { printf("No Lindblad terms found, using (more efficient) Schrodinger solver.\n"); } solve_A = ham_A; solve_stiff_A = ham_stiff_A; if (_num_time_dep&&_stiff_solver) { if(nid==0) printf("ERROR! Schrodinger-stiff + timedep solver untested."); exit(0); } } /* Possibly print dense ham. No stabilization is needed? */ if (nid==0) { /* Print dense ham, if it was asked for */ if (_print_dense_ham){ FILE *fp_ham; fp_ham = fopen("ham","w"); if (nid==0){ for (i=0;i<total_levels;i++){ for (j=0;j<total_levels;j++){ fprintf(fp_ham,"%e %e ",PetscRealPart(_hamiltonian[i][j]),PetscImaginaryPart(_hamiltonian[i][j])); } fprintf(fp_ham,"\n"); } } fclose(fp_ham); for (i=0;i<total_levels;i++){ free(_hamiltonian[i]); } free(_hamiltonian); _print_dense_ham = 0; } } /* Remove stabilization if it was previously added */ if (stab_added){ if (nid==0) printf("Removing stabilization...\n"); /* * We add 1.0 in the 0th spot and every n+1 after */ if (nid==0) { row = 0; for (i=0;i<total_levels;i++){ col = i*(total_levels+1); mat_tmp = -1.0 + 0.*PETSC_i; MatSetValue(full_A,row,col,mat_tmp,ADD_VALUES); } } } MatGetOwnershipRange(solve_A,&Istart,&Iend); /* * Explicitly add 0.0 to all diagonal elements; * this fixes a 'matrix in wrong state' message that PETSc * gives if the diagonal was never initialized. */ //if (nid==0) printf("Adding 0 to diagonal elements...\n"); for (i=Istart;i<Iend;i++){ mat_tmp = 0 + 0.*PETSC_i; MatSetValue(solve_A,i,i,mat_tmp,ADD_VALUES); } if(_stiff_solver){ MatGetOwnershipRange(solve_stiff_A,&Istart,&Iend); for (i=Istart;i<Iend;i++){ mat_tmp = 0 + 0.*PETSC_i; MatSetValue(solve_stiff_A,i,i,mat_tmp,ADD_VALUES); } } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -* * Create the timestepping solver and set various options * *- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* * Create timestepping solver context */ TSCreate(PETSC_COMM_WORLD,&ts); TSSetProblemType(ts,TS_LINEAR); /* * Set function to get information at every timestep */ if (_ts_monitor!=NULL){ TSMonitorSet(ts,_ts_monitor,_tsctx,NULL); } /* * Set up ODE system */ TSSetRHSFunction(ts,NULL,TSComputeRHSFunctionLinear,NULL); if(_stiff_solver) { /* TSSetIFunction(ts,NULL,TSComputeRHSFunctionLinear,NULL); */ if (nid==0) { printf("Stiff solver not implemented!\n"); exit(0); } if(nid==0) printf("Using stiff solver - TSROSW\n"); } if(_num_time_dep+_num_time_dep_lin) { for(i=0;i<_num_time_dep;i++){ tmp_real = 0.0; _add_ops_to_mat_ham(tmp_real,solve_A,_time_dep_list[i].num_ops,_time_dep_list[i].ops); } for(i=0;i<_num_time_dep_lin;i++){ tmp_real = 0.0; _add_ops_to_mat_lin(tmp_real,solve_A,_time_dep_list_lin[i].num_ops,_time_dep_list_lin[i].ops); } /* Tell PETSc to assemble the matrix */ MatAssemblyBegin(solve_A,MAT_FINAL_ASSEMBLY); MatAssemblyEnd(solve_A,MAT_FINAL_ASSEMBLY); if (nid==0) printf("Matrix Assembled.\n"); MatDuplicate(solve_A,MAT_COPY_VALUES,&AA); MatAssemblyBegin(AA,MAT_FINAL_ASSEMBLY); MatAssemblyEnd(AA,MAT_FINAL_ASSEMBLY); TSSetRHSJacobian(ts,AA,AA,_RHS_time_dep_ham_p,NULL); } else { /* Tell PETSc to assemble the matrix */ MatAssemblyBegin(solve_A,MAT_FINAL_ASSEMBLY); MatAssemblyEnd(solve_A,MAT_FINAL_ASSEMBLY); if (_stiff_solver){ MatAssemblyBegin(solve_stiff_A,MAT_FINAL_ASSEMBLY); MatAssemblyEnd(solve_stiff_A,MAT_FINAL_ASSEMBLY); /* TSSetIJacobian(ts,solve_stiff_A,solve_stiff_A,TSComputeRHSJacobianConstant,NULL); */ if (nid==0) { printf("Stiff solver not implemented!\n"); exit(0); } } if (nid==0) printf("Matrix Assembled.\n"); TSSetRHSJacobian(ts,solve_A,solve_A,TSComputeRHSJacobianConstant,NULL); } /* Print information about the matrix. */ PetscViewerASCIIOpen(PETSC_COMM_WORLD,NULL,&mat_view); PetscViewerPushFormat(mat_view,PETSC_VIEWER_ASCII_INFO); /* PetscViewerPushFormat(mat_view,PETSC_VIEWER_ASCII_MATLAB); */ /* MatView(solve_A,mat_view); */ /* PetscInt ncols; */ /* const PetscInt *cols; */ /* const PetscScalar *vals; */ /* for(i=0;i<total_levels*total_levels;i++){ */ /* MatGetRow(solve_A,i,&ncols,&cols,&vals); */ /* for (j=0;j<ncols;j++){ */ /* if(PetscAbsComplex(vals[j])>1e-5){ */ /* printf("%d %d %lf %lf\n",i,cols[j],vals[j]); */ /* } */ /* } */ /* MatRestoreRow(solve_A,i,&ncols,&cols,&vals); */ /* } */ if(_stiff_solver){ MatView(solve_stiff_A,mat_view); } PetscViewerPopFormat(mat_view); PetscViewerDestroy(&mat_view); TSSetTimeStep(ts,dt); /* * Set default options, can be changed at runtime */ TSSetMaxSteps(ts,steps_max); TSSetMaxTime(ts,time_max); TSSetTime(ts,init_time); TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER); if (_stiff_solver) { TSSetType(ts,TSROSW); } else { TSSetType(ts,TSRK); TSRKSetType(ts,TSRK3BS); } /* If we have gates to apply, set up the event handler. */ if (_num_quantum_gates > 0) { nevents = 1; //Only one event for now (did we cross a gate?) direction = -1; //We only want to count an event if we go from positive to negative terminate = PETSC_FALSE; //Keep time stepping after we passed our event /* Arguments are: ts context, nevents, direction of zero crossing, whether to terminate, * a function to check event status, a function to apply events, private data context. */ TSSetEventHandler(ts,nevents,&direction,&terminate,_QG_EventFunction,_QG_PostEventFunction,NULL); } if (_num_circuits > 0) { nevents = 1; //Only one event for now (did we cross a gate?) direction = -1; //We only want to count an event if we go from positive to negative terminate = PETSC_FALSE; //Keep time stepping after we passed our event /* Arguments are: ts context, nevents, direction of zero crossing, whether to terminate, * a function to check event status, a function to apply events, private data context. */ TSSetEventHandler(ts,nevents,&direction,&terminate,_QC_EventFunction,_QC_PostEventFunction,NULL); } if (_discrete_ec > 0) { nevents = 1; //Only one event for now (did we cross an ec step?) direction = -1; //We only want to count an event if we go from positive to negative terminate = PETSC_FALSE; //Keep time stepping after we passed our event /* Arguments are: ts context, nevents, direction of zero crossing, whether to terminate, * a function to check event status, a function to apply events, private data context. */ TSSetEventHandler(ts,nevents,&direction,&terminate,_DQEC_EventFunction,_DQEC_PostEventFunction,NULL); } /* if (_lindblad_terms) { */ /* nevents = 1; //Only one event for now (did we cross a gate?) */ /* direction = 0; //We only want to count an event if we go from positive to negative */ /* terminate = PETSC_FALSE; //Keep time stepping after we passed our event */ /* TSSetEventHandler(ts,nevents,&direction,&terminate,_Normalize_EventFunction,_Normalize_PostEventFunction,NULL); */ /* } */ TSSetFromOptions(ts); TSSolve(ts,x); TSGetStepNumber(ts,&steps); num_pop = get_num_populations(); populations = malloc(num_pop*sizeof(double)); get_populations(x,&populations); /* if(nid==0){ */ /* printf("Final populations: "); */ /* for(i=0;i<num_pop;i++){ */ /* printf(" %e ",populations[i]); */ /* } */ /* printf("\n"); */ /* } */ /* PetscPrintf(PETSC_COMM_WORLD,"Steps %D\n",steps); */ /* Free work space */ TSDestroy(&ts); if(_num_time_dep+_num_time_dep_lin){ MatDestroy(&AA); } free(populations); PetscLogStagePop(); PetscLogStagePush(post_solve_stage); return; }
void PETSC_STDCALL tssettime_(TS ts,PetscReal *t, int *__ierr ){ *__ierr = TSSetTime( (TS)PetscToPointer((ts) ),*t); }
int main(int argc,char **argv) { TS ts; /* ODE integrator */ Vec U; /* solution will be stored here */ PetscErrorCode ierr; PetscMPIInt size; PetscInt n = 2; PetscScalar *u; AppCtx app; PetscInt direction[2]; PetscBool terminate[2]; PetscBool rhs_form=PETSC_FALSE,hist=PETSC_TRUE; TSAdapt adapt; /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Initialize program - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr; ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); if (size > 1) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Only for sequential runs"); app.nbounces = 0; app.maxbounces = 10; ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"ex40 options","");CHKERRQ(ierr); ierr = PetscOptionsInt("-maxbounces","","",app.maxbounces,&app.maxbounces,NULL);CHKERRQ(ierr); ierr = PetscOptionsBool("-test_adapthistory","","",hist,&hist,NULL);CHKERRQ(ierr); ierr = PetscOptionsEnd();CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create timestepping solver context - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr); ierr = TSSetType(ts,TSROSW);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set ODE routines - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr); /* Users are advised against the following branching and code duplication. For problems without a mass matrix like the one at hand, the RHSFunction (and companion RHSJacobian) interface is enough to support both explicit and implicit timesteppers. This tutorial example also deals with the IFunction/IJacobian interface for demonstration and testing purposes. */ ierr = PetscOptionsGetBool(NULL,NULL,"-rhs-form",&rhs_form,NULL);CHKERRQ(ierr); if (rhs_form) { ierr = TSSetRHSFunction(ts,NULL,RHSFunction,NULL);CHKERRQ(ierr); ierr = TSSetRHSJacobian(ts,NULL,NULL,RHSJacobian,NULL);CHKERRQ(ierr); } else { Mat A; /* Jacobian matrix */ ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr); ierr = MatSetSizes(A,n,n,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr); ierr = MatSetType(A,MATDENSE);CHKERRQ(ierr); ierr = MatSetFromOptions(A);CHKERRQ(ierr); ierr = MatSetUp(A);CHKERRQ(ierr); ierr = TSSetIFunction(ts,NULL,IFunction,NULL);CHKERRQ(ierr); ierr = TSSetIJacobian(ts,A,A,IJacobian,NULL);CHKERRQ(ierr); ierr = MatDestroy(&A);CHKERRQ(ierr); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set initial conditions - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = VecCreate(PETSC_COMM_WORLD,&U);CHKERRQ(ierr); ierr = VecSetSizes(U,n,PETSC_DETERMINE);CHKERRQ(ierr); ierr = VecSetUp(U);CHKERRQ(ierr); ierr = VecGetArray(U,&u);CHKERRQ(ierr); u[0] = 0.0; u[1] = 20.0; ierr = VecRestoreArray(U,&u);CHKERRQ(ierr); ierr = TSSetSolution(ts,U);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set solver options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr); ierr = TSSetMaxTime(ts,30.0);CHKERRQ(ierr); ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr); ierr = TSSetTimeStep(ts,0.1);CHKERRQ(ierr); /* The adapative time step controller could take very large timesteps resulting in the same event occuring multiple times in the same interval. A maximum step size limit is enforced here to avoid this issue. */ ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr); ierr = TSAdaptSetStepLimits(adapt,0.0,0.5);CHKERRQ(ierr); /* Set directions and terminate flags for the two events */ direction[0] = -1; direction[1] = -1; terminate[0] = PETSC_FALSE; terminate[1] = PETSC_TRUE; ierr = TSSetEventHandler(ts,2,direction,terminate,EventFunction,PostEventFunction,(void*)&app);CHKERRQ(ierr); ierr = TSSetFromOptions(ts);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Run timestepping solver - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSolve(ts,U);CHKERRQ(ierr); if (hist) { /* replay following history */ TSTrajectory tj; PetscReal tf,t0,dt; app.nbounces = 0; ierr = TSGetTime(ts,&tf);CHKERRQ(ierr); ierr = TSSetMaxTime(ts,tf);CHKERRQ(ierr); ierr = TSSetStepNumber(ts,0);CHKERRQ(ierr); ierr = TSRestartStep(ts);CHKERRQ(ierr); ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr); ierr = TSSetFromOptions(ts);CHKERRQ(ierr); ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr); ierr = TSAdaptSetType(adapt,TSADAPTHISTORY);CHKERRQ(ierr); ierr = TSGetTrajectory(ts,&tj);CHKERRQ(ierr); ierr = TSAdaptHistorySetTrajectory(adapt,tj,PETSC_FALSE);CHKERRQ(ierr); ierr = TSAdaptHistoryGetStep(adapt,0,&t0,&dt);CHKERRQ(ierr); /* this example fails with single (or smaller) precision */ #if defined(PETSC_USE_REAL_SINGLE) || defined(PETSC_USE_REAL__FP16) ierr = TSAdaptSetType(adapt,TSADAPTBASIC);CHKERRQ(ierr); ierr = TSAdaptSetStepLimits(adapt,0.0,0.5);CHKERRQ(ierr); ierr = TSSetFromOptions(ts);CHKERRQ(ierr); #endif ierr = TSSetTime(ts,t0);CHKERRQ(ierr); ierr = TSSetTimeStep(ts,dt);CHKERRQ(ierr); ierr = TSResetTrajectory(ts);CHKERRQ(ierr); ierr = VecGetArray(U,&u);CHKERRQ(ierr); u[0] = 0.0; u[1] = 20.0; ierr = VecRestoreArray(U,&u);CHKERRQ(ierr); ierr = TSSolve(ts,U);CHKERRQ(ierr); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Free work space. All PETSc objects should be destroyed when they are no longer needed. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = VecDestroy(&U);CHKERRQ(ierr); ierr = TSDestroy(&ts);CHKERRQ(ierr); ierr = PetscFinalize(); return ierr; }