PetscErrorCode Parameter_settings(AppCtx *user) { PetscErrorCode ierr; PetscBool flg; PetscFunctionBeginUser; /* Set default parameters */ user->ws = 1.0; user->H = 5.0; user->Pmax = 2.1; user->PM_min = 1.0; user->lambda = 0.1; user->q = 1.0; user->mux = PetscAsinScalar(user->PM_min/user->Pmax); user->sigmax = 0.1; user->sigmay = 0.1; user->rho = 0.0; user->xmin = -PETSC_PI; user->xmax = PETSC_PI; user->bx = DM_BOUNDARY_PERIODIC; user->by = DM_BOUNDARY_MIRROR; user->nonoiseinitial = PETSC_FALSE; /* ymin of -3 seems to let the unstable solution move up and leave a zero in its wake with an ymin of -1 the wake is never exactly zero */ user->ymin = -3.0; user->ymax = 10.0; user->st_width = 1; ierr = PetscOptionsGetScalar(NULL,"-ws",&user->ws,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetScalar(NULL,"-Inertia",&user->H,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetScalar(NULL,"-Pmax",&user->Pmax,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetScalar(NULL,"-PM_min",&user->PM_min,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetScalar(NULL,"-lambda",&user->lambda,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetScalar(NULL,"-q",&user->q,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetScalar(NULL,"-mux",&user->mux,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetScalar(NULL,"-sigmax",&user->sigmax,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetScalar(NULL,"-muy",&user->muy,&flg);CHKERRQ(ierr); if (flg == 0) { user->muy = user->ws; } ierr = PetscOptionsGetScalar(NULL,"-sigmay",&user->sigmay,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetScalar(NULL,"-rho",&user->rho,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetScalar(NULL,"-xmin",&user->xmin,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetScalar(NULL,"-xmax",&user->xmax,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetScalar(NULL,"-ymin",&user->ymin,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetScalar(NULL,"-ymax",&user->ymax,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,"-stencil_width",&user->st_width,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetEnum(NULL,"-bx",DMBoundaryTypes,(PetscEnum*)&user->bx,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetEnum(NULL,"-by",DMBoundaryTypes,(PetscEnum*)&user->by,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetBool(NULL,"-nonoiseinitial",&user->nonoiseinitial,&flg);CHKERRQ(ierr); PetscFunctionReturn(0); }
PetscErrorCode Parameter_settings(AppCtx *user) { PetscErrorCode ierr; PetscBool flg; PetscFunctionBeginUser; /* Set default parameters */ user->ws = 1.0; user->H = 5.0; user->D = 0.0; user->Pmax = user->Pmax_s = 2.1; user->PM_min = 1.0; user->lambda = 0.1; user->q = 1.0; user->mux = PetscAsinScalar(user->PM_min/user->Pmax); user->sigmax = 0.1; user->sigmay = 0.1; user->rho = 0.0; user->xmin = -PETSC_PI; user->xmax = PETSC_PI; user->bx = DM_BOUNDARY_PERIODIC; user->by = DM_BOUNDARY_GHOSTED; user->tf = user->tcl = -1; user->ymin = -2.0; user->ymax = 2.0; user->st_width = 1; ierr = PetscOptionsGetScalar(NULL,"-ws",&user->ws,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetScalar(NULL,"-Inertia",&user->H,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetScalar(NULL,"-D",&user->D,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetScalar(NULL,"-Pmax",&user->Pmax,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetScalar(NULL,"-PM_min",&user->PM_min,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetScalar(NULL,"-lambda",&user->lambda,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetScalar(NULL,"-q",&user->q,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetScalar(NULL,"-mux",&user->mux,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetScalar(NULL,"-muy",&user->muy,&flg);CHKERRQ(ierr); if (flg == 0) { user->muy = user->ws; } ierr = PetscOptionsGetScalar(NULL,"-xmin",&user->xmin,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetScalar(NULL,"-xmax",&user->xmax,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetScalar(NULL,"-ymin",&user->ymin,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetScalar(NULL,"-ymax",&user->ymax,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,"-stencil_width",&user->st_width,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetEnum("","-bx",BoundaryTypes,(PetscEnum*)&user->bx,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetEnum("","-by",BoundaryTypes,(PetscEnum*)&user->by,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetReal(NULL,"-tf",&user->tf,&flg);CHKERRQ(ierr); ierr = PetscOptionsGetReal(NULL,"-tcl",&user->tcl,&flg);CHKERRQ(ierr); PetscFunctionReturn(0); }
int main(int argc,char **argv) { TS ts; /* ODE integrator */ Vec U; /* solution will be stored here */ Mat A; /* Jacobian matrix */ Mat Jacp; /* Jacobian matrix */ PetscErrorCode ierr; PetscMPIInt size; PetscInt n = 2; AppCtx ctx; PetscScalar *u; PetscReal du[2] = {0.0,0.0}; PetscBool ensemble = PETSC_FALSE,flg1,flg2; PetscReal ftime; PetscInt steps; PetscScalar *x_ptr,*y_ptr; Vec lambda[1],q,mu[1]; /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Initialize program - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(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"); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create necessary matrix and vectors - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 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 = MatCreateVecs(A,&U,NULL);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_WORLD,&Jacp);CHKERRQ(ierr); ierr = MatSetSizes(Jacp,PETSC_DECIDE,PETSC_DECIDE,2,1);CHKERRQ(ierr); ierr = MatSetFromOptions(Jacp);CHKERRQ(ierr); ierr = MatSetUp(Jacp);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set runtime options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"Swing equation options","");CHKERRQ(ierr); { ctx.beta = 2; ctx.c = 10000.0; ctx.u_s = 1.0; ctx.omega_s = 1.0; ctx.omega_b = 120.0*PETSC_PI; ctx.H = 5.0; ierr = PetscOptionsScalar("-Inertia","","",ctx.H,&ctx.H,NULL);CHKERRQ(ierr); ctx.D = 5.0; ierr = PetscOptionsScalar("-D","","",ctx.D,&ctx.D,NULL);CHKERRQ(ierr); ctx.E = 1.1378; ctx.V = 1.0; ctx.X = 0.545; ctx.Pmax = ctx.E*ctx.V/ctx.X;; ierr = PetscOptionsScalar("-Pmax","","",ctx.Pmax,&ctx.Pmax,NULL);CHKERRQ(ierr); ctx.Pm = 1.1; ierr = PetscOptionsScalar("-Pm","","",ctx.Pm,&ctx.Pm,NULL);CHKERRQ(ierr); ctx.tf = 0.1; ctx.tcl = 0.2; ierr = PetscOptionsReal("-tf","Time to start fault","",ctx.tf,&ctx.tf,NULL);CHKERRQ(ierr); ierr = PetscOptionsReal("-tcl","Time to end fault","",ctx.tcl,&ctx.tcl,NULL);CHKERRQ(ierr); ierr = PetscOptionsBool("-ensemble","Run ensemble of different initial conditions","",ensemble,&ensemble,NULL);CHKERRQ(ierr); if (ensemble) { ctx.tf = -1; ctx.tcl = -1; } ierr = VecGetArray(U,&u);CHKERRQ(ierr); u[0] = PetscAsinScalar(ctx.Pm/ctx.Pmax); u[1] = 1.0; ierr = PetscOptionsRealArray("-u","Initial solution","",u,&n,&flg1);CHKERRQ(ierr); n = 2; ierr = PetscOptionsRealArray("-du","Perturbation in initial solution","",du,&n,&flg2);CHKERRQ(ierr); u[0] += du[0]; u[1] += du[1]; ierr = VecRestoreArray(U,&u);CHKERRQ(ierr); if (flg1 || flg2) { ctx.tf = -1; ctx.tcl = -1; } } ierr = PetscOptionsEnd();CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create timestepping solver context - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr); ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr); ierr = TSSetType(ts,TSRK);CHKERRQ(ierr); ierr = TSSetRHSFunction(ts,NULL,(TSRHSFunction)RHSFunction,&ctx);CHKERRQ(ierr); ierr = TSSetRHSJacobian(ts,A,A,(TSRHSJacobian)RHSJacobian,&ctx);CHKERRQ(ierr); ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set initial conditions - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetSolution(ts,U);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Save trajectory of solution so that TSAdjointSolve() may be used - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr); ierr = MatCreateVecs(A,&lambda[0],NULL);CHKERRQ(ierr); /* Set initial conditions for the adjoint integration */ ierr = VecGetArray(lambda[0],&y_ptr);CHKERRQ(ierr); y_ptr[0] = 0.0; y_ptr[1] = 0.0; ierr = VecRestoreArray(lambda[0],&y_ptr);CHKERRQ(ierr); ierr = MatCreateVecs(Jacp,&mu[0],NULL);CHKERRQ(ierr); ierr = VecGetArray(mu[0],&x_ptr);CHKERRQ(ierr); x_ptr[0] = -1.0; ierr = VecRestoreArray(mu[0],&x_ptr);CHKERRQ(ierr); ierr = TSSetCostGradients(ts,1,lambda,mu);CHKERRQ(ierr); ierr = TSSetCostIntegrand(ts,1,(PetscErrorCode (*)(TS,PetscReal,Vec,Vec,void*))CostIntegrand, (PetscErrorCode (*)(TS,PetscReal,Vec,Vec*,void*))DRDYFunction, (PetscErrorCode (*)(TS,PetscReal,Vec,Vec*,void*))DRDPFunction,PETSC_TRUE,&ctx);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set solver options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetDuration(ts,PETSC_DEFAULT,10.0);CHKERRQ(ierr); ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr); ierr = TSSetInitialTimeStep(ts,0.0,.01);CHKERRQ(ierr); ierr = TSSetFromOptions(ts);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Solve nonlinear system - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ if (ensemble) { for (du[1] = -2.5; du[1] <= .01; du[1] += .1) { ierr = VecGetArray(U,&u);CHKERRQ(ierr); u[0] = PetscAsinScalar(ctx.Pm/ctx.Pmax); u[1] = ctx.omega_s; u[0] += du[0]; u[1] += du[1]; ierr = VecRestoreArray(U,&u);CHKERRQ(ierr); ierr = TSSetInitialTimeStep(ts,0.0,.01);CHKERRQ(ierr); ierr = TSSolve(ts,U);CHKERRQ(ierr); } } else { ierr = TSSolve(ts,U);CHKERRQ(ierr); } ierr = VecView(U,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr); ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Adjoint model starts here - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* Set initial conditions for the adjoint integration */ ierr = VecGetArray(lambda[0],&y_ptr);CHKERRQ(ierr); y_ptr[0] = 0.0; y_ptr[1] = 0.0; ierr = VecRestoreArray(lambda[0],&y_ptr);CHKERRQ(ierr); ierr = VecGetArray(mu[0],&x_ptr);CHKERRQ(ierr); x_ptr[0] = -1.0; ierr = VecRestoreArray(mu[0],&x_ptr);CHKERRQ(ierr); /* Set RHS JacobianP */ ierr = TSAdjointSetRHSJacobian(ts,Jacp,RHSJacobianP,&ctx);CHKERRQ(ierr); ierr = TSAdjointSolve(ts);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"\n sensitivity wrt initial conditions: d[Psi(tf)]/d[phi0] d[Psi(tf)]/d[omega0]\n");CHKERRQ(ierr); ierr = VecView(lambda[0],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = VecView(mu[0],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = TSGetCostIntegral(ts,&q);CHKERRQ(ierr); ierr = VecView(q,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = VecGetArray(q,&x_ptr);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"\n cost function=%g\n",(double)(x_ptr[0]-ctx.Pm));CHKERRQ(ierr); ierr = VecRestoreArray(q,&x_ptr);CHKERRQ(ierr); ierr = ComputeSensiP(lambda[0],mu[0],&ctx);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Free work space. All PETSc objects should be destroyed when they are no longer needed. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = MatDestroy(&Jacp);CHKERRQ(ierr); ierr = VecDestroy(&U);CHKERRQ(ierr); ierr = VecDestroy(&lambda[0]);CHKERRQ(ierr); ierr = VecDestroy(&mu[0]);CHKERRQ(ierr); ierr = TSDestroy(&ts);CHKERRQ(ierr); ierr = PetscFinalize(); return(0); }
int main(int argc,char **argv) { TS ts; /* ODE integrator */ Vec U; /* solution will be stored here */ Mat A; /* Jacobian matrix */ PetscErrorCode ierr; PetscMPIInt size; PetscInt n = 2; AppCtx ctx; PetscScalar *u; PetscReal du[2] = {0.0,0.0}; PetscBool ensemble = PETSC_FALSE,flg1,flg2; /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Initialize program - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(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"); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create necessary matrix and vectors - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 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 = MatCreateVecs(A,&U,NULL);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set runtime options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"Swing equation options","");CHKERRQ(ierr); { ctx.omega_s = 2.0*PETSC_PI*60.0; ctx.H = 5.0; ierr = PetscOptionsScalar("-Inertia","","",ctx.H,&ctx.H,NULL);CHKERRQ(ierr); ctx.D = 5.0; ierr = PetscOptionsScalar("-D","","",ctx.D,&ctx.D,NULL);CHKERRQ(ierr); ctx.E = 1.1378; ctx.V = 1.0; ctx.X = 0.545; ctx.Pmax = ctx.E*ctx.V/ctx.X;; ierr = PetscOptionsScalar("-Pmax","","",ctx.Pmax,&ctx.Pmax,NULL);CHKERRQ(ierr); ctx.Pm = 0.9; ierr = PetscOptionsScalar("-Pm","","",ctx.Pm,&ctx.Pm,NULL);CHKERRQ(ierr); ctx.tf = 1.0; ctx.tcl = 1.05; ierr = PetscOptionsReal("-tf","Time to start fault","",ctx.tf,&ctx.tf,NULL);CHKERRQ(ierr); ierr = PetscOptionsReal("-tcl","Time to end fault","",ctx.tcl,&ctx.tcl,NULL);CHKERRQ(ierr); ierr = PetscOptionsBool("-ensemble","Run ensemble of different initial conditions","",ensemble,&ensemble,NULL);CHKERRQ(ierr); if (ensemble) { ctx.tf = -1; ctx.tcl = -1; } ierr = VecGetArray(U,&u);CHKERRQ(ierr); u[0] = PetscAsinScalar(ctx.Pm/ctx.Pmax); u[1] = 1.0; ierr = PetscOptionsRealArray("-u","Initial solution","",u,&n,&flg1);CHKERRQ(ierr); n = 2; ierr = PetscOptionsRealArray("-du","Perturbation in initial solution","",du,&n,&flg2);CHKERRQ(ierr); u[0] += du[0]; u[1] += du[1]; ierr = VecRestoreArray(U,&u);CHKERRQ(ierr); if (flg1 || flg2) { ctx.tf = -1; ctx.tcl = -1; } } ierr = PetscOptionsEnd();CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create timestepping solver context - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr); ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr); ierr = TSSetType(ts,TSROSW);CHKERRQ(ierr); ierr = TSSetIFunction(ts,NULL,(TSIFunction) IFunction,&ctx);CHKERRQ(ierr); ierr = TSSetIJacobian(ts,A,A,(TSIJacobian)IJacobian,&ctx);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set initial conditions - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetSolution(ts,U);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set solver options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetDuration(ts,100000,35.0);CHKERRQ(ierr); ierr = TSSetInitialTimeStep(ts,0.0,.01);CHKERRQ(ierr); ierr = TSSetFromOptions(ts);CHKERRQ(ierr); /* ierr = TSSetPostStep(ts,PostStep);CHKERRQ(ierr); */ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Solve nonlinear system - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ if (ensemble) { for (du[1] = -2.5; du[1] <= .01; du[1] += .1) { ierr = VecGetArray(U,&u);CHKERRQ(ierr); u[0] = PetscAsinScalar(ctx.Pm/ctx.Pmax); u[1] = ctx.omega_s; u[0] += du[0]; u[1] += du[1]; ierr = VecRestoreArray(U,&u);CHKERRQ(ierr); ierr = TSSetInitialTimeStep(ts,0.0,.01);CHKERRQ(ierr); ierr = TSSolve(ts,U);CHKERRQ(ierr); } } else { ierr = TSSolve(ts,U);CHKERRQ(ierr); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Free work space. All PETSc objects should be destroyed when they are no longer needed. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = VecDestroy(&U);CHKERRQ(ierr); ierr = TSDestroy(&ts);CHKERRQ(ierr); ierr = PetscFinalize(); return(0); }
/* FormFunction - 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 */ PetscErrorCode FormFunction(Tao tao,Vec P,PetscReal *f,void *ctx0) { AppCtx *ctx = (AppCtx*)ctx0; TS ts; Vec U; /* solution will be stored here */ Mat A; /* Jacobian matrix */ Mat Jacp; /* Jacobian matrix */ PetscErrorCode ierr; PetscInt n = 2; PetscReal ftime; PetscInt steps; PetscScalar *u; PetscScalar *x_ptr,*y_ptr; Vec lambda[1],q,mu[1]; ierr = VecGetArray(P,&x_ptr);CHKERRQ(ierr); ctx->Pm = x_ptr[0]; /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create necessary matrix and vectors - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 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 = MatCreateVecs(A,&U,NULL);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_WORLD,&Jacp);CHKERRQ(ierr); ierr = MatSetSizes(Jacp,PETSC_DECIDE,PETSC_DECIDE,2,1);CHKERRQ(ierr); ierr = MatSetFromOptions(Jacp);CHKERRQ(ierr); ierr = MatSetUp(Jacp);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create timestepping solver context - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr); ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr); ierr = TSSetType(ts,TSBEULER);CHKERRQ(ierr); ierr = TSSetIFunction(ts,NULL,(TSIFunction) IFunction,ctx);CHKERRQ(ierr); ierr = TSSetIJacobian(ts,A,A,(TSIJacobian)IJacobian,ctx);CHKERRQ(ierr); ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set initial conditions - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = VecGetArray(U,&u);CHKERRQ(ierr); u[0] = PetscAsinScalar(ctx->Pm/ctx->Pmax); u[1] = 1.0; ierr = VecRestoreArray(U,&u);CHKERRQ(ierr); ierr = TSSetSolution(ts,U);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Save trajectory of solution so that TSAdjointSolve() may be used - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set solver options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetDuration(ts,PETSC_DEFAULT,10.0);CHKERRQ(ierr); ierr = TSSetInitialTimeStep(ts,0.0,.01);CHKERRQ(ierr); ierr = TSSetFromOptions(ts);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Solve nonlinear system - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSolve(ts,U);CHKERRQ(ierr); ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr); ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Adjoint model starts here - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = MatCreateVecs(A,&lambda[0],NULL);CHKERRQ(ierr); /* Set initial conditions for the adjoint integration */ ierr = VecGetArray(lambda[0],&y_ptr);CHKERRQ(ierr); y_ptr[0] = 0.0; y_ptr[1] = 0.0; ierr = VecRestoreArray(lambda[0],&y_ptr);CHKERRQ(ierr); ierr = MatCreateVecs(Jacp,&mu[0],NULL);CHKERRQ(ierr); ierr = VecGetArray(mu[0],&x_ptr);CHKERRQ(ierr); x_ptr[0] = -1.0; ierr = VecRestoreArray(mu[0],&x_ptr);CHKERRQ(ierr); ierr = TSAdjointSetCostGradients(ts,1,lambda,mu);CHKERRQ(ierr); ierr = TSAdjointSetRHSJacobian(ts,Jacp,RHSJacobianP,ctx);CHKERRQ(ierr); ierr = TSAdjointSetCostIntegrand(ts,1,(PetscErrorCode (*)(TS,PetscReal,Vec,Vec,void*))CostIntegrand, (PetscErrorCode (*)(TS,PetscReal,Vec,Vec*,void*))DRDYFunction, (PetscErrorCode (*)(TS,PetscReal,Vec,Vec*,void*))DRDPFunction,ctx);CHKERRQ(ierr); ierr = TSAdjointSolve(ts);CHKERRQ(ierr); ierr = TSAdjointGetCostIntegral(ts,&q);CHKERRQ(ierr); ierr = ComputeSensiP(lambda[0],mu[0],ctx);CHKERRQ(ierr); ierr = VecGetArray(q,&x_ptr);CHKERRQ(ierr); *f = -ctx->Pm + x_ptr[0]; /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Free work space. All PETSc objects should be destroyed when they are no longer needed. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = MatDestroy(&Jacp);CHKERRQ(ierr); ierr = VecDestroy(&U);CHKERRQ(ierr); ierr = VecDestroy(&lambda[0]);CHKERRQ(ierr); ierr = VecDestroy(&mu[0]);CHKERRQ(ierr); ierr = TSDestroy(&ts);CHKERRQ(ierr); return 0; }