Exemple #1
0
int main(int argc, char **argv)
{
  PetscErrorCode ierr;
  Vec            x;  /* Solution vector */
  TS             ts;   /* Time-stepping context */
  AppCtx         user; /* Application context */
  Mat            J;
  PetscViewer    viewer;

  PetscInitialize(&argc,&argv,"petscopt_ex6", help);

  /* Get physics and time parameters */
  ierr = Parameter_settings(&user);CHKERRQ(ierr);
  /* Create a 2D DA with dof = 1 */
  ierr = DMDACreate2d(PETSC_COMM_WORLD,DMDA_BOUNDARY_NONE,DMDA_BOUNDARY_NONE,DMDA_STENCIL_STAR,-4,-4,PETSC_DECIDE,PETSC_DECIDE,1,1,NULL,NULL,&user.da);CHKERRQ(ierr);
  /* Set x and y coordinates */
  ierr = DMDASetUniformCoordinates(user.da,user.xmin,user.xmax,user.ymin,user.ymax,NULL,NULL);CHKERRQ(ierr);

  /* Get global vector x from DM  */
  ierr = DMCreateGlobalVector(user.da,&x);CHKERRQ(ierr);

  ierr = ini_bou(x,&user);CHKERRQ(ierr);
  ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"ini_x",FILE_MODE_WRITE,&viewer);CHKERRQ(ierr);
  ierr = VecView(x,viewer);CHKERRQ(ierr);
  ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);

  /* Get Jacobian matrix structure from the da */
  ierr = DMSetMatType(user.da,MATAIJ);CHKERRQ(ierr);
  ierr = DMCreateMatrix(user.da,&J);CHKERRQ(ierr);

  ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
  ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
  ierr = TSSetIFunction(ts,NULL,IFunction,&user);CHKERRQ(ierr);
  ierr = TSSetIJacobian(ts,J,J,IJacobian,&user);CHKERRQ(ierr);
  ierr = TSSetApplicationContext(ts,&user);CHKERRQ(ierr);
  ierr = TSSetDuration(ts,PETSC_DEFAULT,user.tmax);CHKERRQ(ierr);
  ierr = TSSetInitialTimeStep(ts,user.t0,.005);CHKERRQ(ierr);
  ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
  ierr = TSSetPostStep(ts,PostStep);CHKERRQ(ierr);
  ierr = TSSolve(ts,x);CHKERRQ(ierr);

  ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"fin_x",FILE_MODE_WRITE,&viewer);CHKERRQ(ierr);
  ierr = VecView(x,viewer);CHKERRQ(ierr);
  ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);

  ierr = VecDestroy(&x);CHKERRQ(ierr);
  ierr = MatDestroy(&J);CHKERRQ(ierr);
  ierr = DMDestroy(&user.da);CHKERRQ(ierr);
  ierr = TSDestroy(&ts);CHKERRQ(ierr);
  PetscFinalize();
  return 0;
}
Exemple #2
0
int main(int argc, char **argv)
{
  PetscErrorCode ierr;
  Vec            x;  /* Solution vector */
  TS             ts;   /* Time-stepping context */
  AppCtx         user; /* Application context */
  PetscViewer    viewer;

  PetscInitialize(&argc,&argv,"petscopt_ex7", help);

  /* Get physics and time parameters */
  ierr = Parameter_settings(&user);CHKERRQ(ierr);
  /* Create a 2D DA with dof = 1 */
  ierr = DMDACreate2d(PETSC_COMM_WORLD,user.bx,user.by,DMDA_STENCIL_STAR,-4,-4,PETSC_DECIDE,PETSC_DECIDE,1,user.st_width,NULL,NULL,&user.da);CHKERRQ(ierr);
  /* Set x and y coordinates */
  ierr = DMDASetUniformCoordinates(user.da,user.xmin,user.xmax,user.ymin,user.ymax,0,0);CHKERRQ(ierr);
  ierr = DMDASetCoordinateName(user.da,0,"X - the angle");
  ierr = DMDASetCoordinateName(user.da,1,"Y - the speed");

  /* Get global vector x from DM  */
  ierr = DMCreateGlobalVector(user.da,&x);CHKERRQ(ierr);

  ierr = ini_bou(x,&user);CHKERRQ(ierr);
  ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"ini_x",FILE_MODE_WRITE,&viewer);CHKERRQ(ierr);
  ierr = VecView(x,viewer);CHKERRQ(ierr);
  ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);

  ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
  ierr = TSSetDM(ts,user.da);CHKERRQ(ierr);
  ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
  ierr = TSSetType(ts,TSARKIMEX);CHKERRQ(ierr);
  ierr = TSSetIFunction(ts,NULL,IFunction,&user);CHKERRQ(ierr);
  /*  ierr = TSSetIJacobian(ts,NULL,NULL,IJacobian,&user);CHKERRQ(ierr);  */
  ierr = TSSetApplicationContext(ts,&user);CHKERRQ(ierr);
  ierr = TSSetInitialTimeStep(ts,0.0,.005);CHKERRQ(ierr);
  ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
  ierr = TSSetPostStep(ts,PostStep);CHKERRQ(ierr);
  ierr = TSSolve(ts,x);CHKERRQ(ierr);

  ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"fin_x",FILE_MODE_WRITE,&viewer);CHKERRQ(ierr);
  ierr = VecView(x,viewer);CHKERRQ(ierr);
  ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);

  ierr = VecDestroy(&x);CHKERRQ(ierr);
  ierr = DMDestroy(&user.da);CHKERRQ(ierr);
  ierr = TSDestroy(&ts);CHKERRQ(ierr);
  PetscFinalize();
  return 0;
}
Exemple #3
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;
}
Exemple #4
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         user;
  PetscScalar    *u;

  /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     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 = MatSetFromOptions(A);CHKERRQ(ierr);
  ierr = MatSetUp(A);CHKERRQ(ierr);

  ierr = MatGetVecs(A,&U,PETSC_NULL);CHKERRQ(ierr);

  /* Create wind speed data using Weibull distribution */
  ierr = WindSpeeds(&user);CHKERRQ(ierr);
  /* Set parameters for wind turbine and induction generator */
  ierr = SetWindTurbineParams(&user);CHKERRQ(ierr);
  ierr = SetInductionGeneratorParams(&user);CHKERRQ(ierr);

  ierr = VecGetArray(U,&u);CHKERRQ(ierr);
  u[0] = vwa;
  u[1] = s;
  ierr = VecRestoreArray(U,&u);CHKERRQ(ierr);

  /* Create matrix to save solutions at each time step */
  user.stepnum = 0;
  ierr = MatCreateSeqDense(PETSC_COMM_SELF,3,2010,PETSC_NULL,&user.Sol);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,PETSC_NULL,(TSIFunction) IFunction,&user);CHKERRQ(ierr);
  SNES snes;
  ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
  ierr = SNESSetJacobian(snes,A,A,SNESDefaultComputeJacobian,PETSC_NULL);CHKERRQ(ierr);
  /*  ierr = TSSetIJacobian(ts,A,A,(TSIJacobian)IJacobian,&user);CHKERRQ(ierr); */
  ierr = TSSetApplicationContext(ts,&user);CHKERRQ(ierr);

  /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     Set initial conditions
   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  ierr = TSSetSolution(ts,U);CHKERRQ(ierr);

  /* Save initial solution */
  PetscScalar *x,*mat;
  PetscInt idx=3*user.stepnum;
  ierr = MatDenseGetArray(user.Sol,&mat);CHKERRQ(ierr);
  ierr = VecGetArray(U,&x);CHKERRQ(ierr);
  mat[idx] = 0.0;
  ierr = PetscMemcpy(mat+idx+1,x,2*sizeof(PetscScalar));CHKERRQ(ierr);
  ierr = MatDenseRestoreArray(user.Sol,&mat);CHKERRQ(ierr);
  ierr = VecRestoreArray(U,&x);CHKERRQ(ierr);
  user.stepnum++;


  /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     Set solver options
   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  ierr = TSSetDuration(ts,2000,20.0);CHKERRQ(ierr);
  ierr = TSSetInitialTimeStep(ts,0.0,.01);CHKERRQ(ierr);
  ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
  ierr = TSSetPostStep(ts,SaveSolution);CHKERRQ(ierr);
  /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     Solve nonlinear system
     - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  ierr = TSSolve(ts,U);CHKERRQ(ierr);

  Mat B;
  PetscScalar *amat;
  ierr = MatCreateSeqDense(PETSC_COMM_SELF,3,user.stepnum,PETSC_NULL,&B);CHKERRQ(ierr);
  ierr = MatDenseGetArray(user.Sol,&mat);CHKERRQ(ierr);
  ierr = MatDenseGetArray(B,&amat);CHKERRQ(ierr);
  ierr = PetscMemcpy(amat,mat,user.stepnum*3*sizeof(PetscScalar));CHKERRQ(ierr);
  ierr = MatDenseRestoreArray(B,&amat);CHKERRQ(ierr);
  ierr = MatDenseRestoreArray(user.Sol,&mat);CHKERRQ(ierr);
  PetscViewer viewer;
  ierr = PetscViewerBinaryOpen(PETSC_COMM_SELF,"out.bin",FILE_MODE_WRITE,&viewer);CHKERRQ(ierr);
  ierr = MatView(B,viewer);CHKERRQ(ierr);
  ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
  ierr = MatDestroy(&user.Sol);CHKERRQ(ierr);
  ierr = MatDestroy(&B);CHKERRQ(ierr);
  /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     Free work space.  All PETSc objects should be destroyed when they are no longer needed.
   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  ierr = VecDestroy(&user.wind_data);CHKERRQ(ierr);
  ierr = VecDestroy(&user.t_wind);CHKERRQ(ierr);
  ierr = MatDestroy(&A);CHKERRQ(ierr);
  ierr = VecDestroy(&U);CHKERRQ(ierr);
  ierr = TSDestroy(&ts);CHKERRQ(ierr);

  ierr = PetscFinalize();
  return(0);
}
Exemple #5
0
int main(int argc,char **argv)
{
  TS             ts;
  SNES           snes_alg;
  PetscErrorCode ierr;
  PetscMPIInt    size;
  Userctx        user;
  PetscViewer    Xview,Ybusview;
  Vec            X;
  Mat            J;
  PetscInt       i;
  /* sensitivity context */
  PetscScalar    *y_ptr;
  Vec            lambda[1];
  PetscInt       *idx2;
  Vec            Xdot;
  Vec            F_alg;
  PetscInt       row_loc,col_loc;
  PetscScalar    val;

  ierr = PetscInitialize(&argc,&argv,"petscoptions",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");

  user.neqs_gen   = 9*ngen; /* # eqs. for generator subsystem */
  user.neqs_net   = 2*nbus; /* # eqs. for network subsystem   */
  user.neqs_pgrid = user.neqs_gen + user.neqs_net;

  /* Create indices for differential and algebraic equations */
  ierr = PetscMalloc1(7*ngen,&idx2);CHKERRQ(ierr);
  for (i=0; i<ngen; i++) {
    idx2[7*i]   = 9*i;   idx2[7*i+1] = 9*i+1; idx2[7*i+2] = 9*i+2; idx2[7*i+3] = 9*i+3;
    idx2[7*i+4] = 9*i+6; idx2[7*i+5] = 9*i+7; idx2[7*i+6] = 9*i+8;
  }
  ierr = ISCreateGeneral(PETSC_COMM_WORLD,7*ngen,idx2,PETSC_COPY_VALUES,&user.is_diff);CHKERRQ(ierr);
  ierr = ISComplement(user.is_diff,0,user.neqs_pgrid,&user.is_alg);CHKERRQ(ierr);
  ierr = PetscFree(idx2);CHKERRQ(ierr);

  /* Read initial voltage vector and Ybus */
  ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"X.bin",FILE_MODE_READ,&Xview);CHKERRQ(ierr);
  ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"Ybus.bin",FILE_MODE_READ,&Ybusview);CHKERRQ(ierr);

  ierr = VecCreate(PETSC_COMM_WORLD,&user.V0);CHKERRQ(ierr);
  ierr = VecSetSizes(user.V0,PETSC_DECIDE,user.neqs_net);CHKERRQ(ierr);
  ierr = VecLoad(user.V0,Xview);CHKERRQ(ierr);

  ierr = MatCreate(PETSC_COMM_WORLD,&user.Ybus);CHKERRQ(ierr);
  ierr = MatSetSizes(user.Ybus,PETSC_DECIDE,PETSC_DECIDE,user.neqs_net,user.neqs_net);CHKERRQ(ierr);
  ierr = MatSetType(user.Ybus,MATBAIJ);CHKERRQ(ierr);
  /*  ierr = MatSetBlockSize(user.Ybus,2);CHKERRQ(ierr); */
  ierr = MatLoad(user.Ybus,Ybusview);CHKERRQ(ierr);

  /* Set run time options */
  ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"Transient stability fault options","");CHKERRQ(ierr);
  {
    user.tfaulton  = 1.0;
    user.tfaultoff = 1.2;
    user.Rfault    = 0.0001;
    user.faultbus  = 8;
    ierr           = PetscOptionsReal("-tfaulton","","",user.tfaulton,&user.tfaulton,NULL);CHKERRQ(ierr);
    ierr           = PetscOptionsReal("-tfaultoff","","",user.tfaultoff,&user.tfaultoff,NULL);CHKERRQ(ierr);
    ierr           = PetscOptionsInt("-faultbus","","",user.faultbus,&user.faultbus,NULL);CHKERRQ(ierr);
    user.t0        = 0.0;
    user.tmax      = 5.0;
    ierr           = PetscOptionsReal("-t0","","",user.t0,&user.t0,NULL);CHKERRQ(ierr);
    ierr           = PetscOptionsReal("-tmax","","",user.tmax,&user.tmax,NULL);CHKERRQ(ierr);
  }
  ierr = PetscOptionsEnd();CHKERRQ(ierr);

  ierr = PetscViewerDestroy(&Xview);CHKERRQ(ierr);
  ierr = PetscViewerDestroy(&Ybusview);CHKERRQ(ierr);

  /* Create DMs for generator and network subsystems */
  ierr = DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,user.neqs_gen,1,1,NULL,&user.dmgen);CHKERRQ(ierr);
  ierr = DMSetOptionsPrefix(user.dmgen,"dmgen_");CHKERRQ(ierr);
  ierr = DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,user.neqs_net,1,1,NULL,&user.dmnet);CHKERRQ(ierr);
  ierr = DMSetOptionsPrefix(user.dmnet,"dmnet_");CHKERRQ(ierr);
  /* Create a composite DM packer and add the two DMs */
  ierr = DMCompositeCreate(PETSC_COMM_WORLD,&user.dmpgrid);CHKERRQ(ierr);
  ierr = DMSetOptionsPrefix(user.dmpgrid,"pgrid_");CHKERRQ(ierr);
  ierr = DMCompositeAddDM(user.dmpgrid,user.dmgen);CHKERRQ(ierr);
  ierr = DMCompositeAddDM(user.dmpgrid,user.dmnet);CHKERRQ(ierr);

  ierr = DMCreateGlobalVector(user.dmpgrid,&X);CHKERRQ(ierr);

  ierr = MatCreate(PETSC_COMM_WORLD,&J);CHKERRQ(ierr);
  ierr = MatSetSizes(J,PETSC_DECIDE,PETSC_DECIDE,user.neqs_pgrid,user.neqs_pgrid);CHKERRQ(ierr);
  ierr = MatSetFromOptions(J);CHKERRQ(ierr);
  ierr = PreallocateJacobian(J,&user);CHKERRQ(ierr);


  /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     Create timestepping solver context
     - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
  ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
  ierr = TSSetType(ts,TSCN);CHKERRQ(ierr);
  ierr = TSSetIFunction(ts,NULL,(TSIFunction) IFunction,&user);CHKERRQ(ierr);
  ierr = TSSetIJacobian(ts,J,J,(TSIJacobian)IJacobian,&user);CHKERRQ(ierr);
  ierr = TSSetApplicationContext(ts,&user);CHKERRQ(ierr);

  /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     Set initial conditions
   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  ierr = SetInitialGuess(X,&user);CHKERRQ(ierr);
  /* Just to set up the Jacobian structure */
  ierr = VecDuplicate(X,&Xdot);CHKERRQ(ierr);
  ierr = IJacobian(ts,0.0,X,Xdot,0.0,J,J,&user);CHKERRQ(ierr);
  ierr = VecDestroy(&Xdot);CHKERRQ(ierr);

  /*
    Save trajectory of solution so that TSAdjointSolve() may be used
  */
  ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr);

  ierr = TSSetDuration(ts,1000,user.tfaulton);CHKERRQ(ierr);
  ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
  ierr = TSSetInitialTimeStep(ts,0.0,0.01);CHKERRQ(ierr);
  ierr = TSSetFromOptions(ts);CHKERRQ(ierr);

  user.alg_flg = PETSC_FALSE;
  /* Prefault period */
  ierr = TSSolve(ts,X);CHKERRQ(ierr);

  /* Create the nonlinear solver for solving the algebraic system */
  /* Note that although the algebraic system needs to be solved only for
     Idq and V, we reuse the entire system including xgen. The xgen
     variables are held constant by setting their residuals to 0 and
     putting a 1 on the Jacobian diagonal for xgen rows
  */
  ierr = VecDuplicate(X,&F_alg);CHKERRQ(ierr);
  ierr = SNESCreate(PETSC_COMM_WORLD,&snes_alg);CHKERRQ(ierr);
  ierr = SNESSetFunction(snes_alg,F_alg,AlgFunction,&user);CHKERRQ(ierr);
  ierr = MatZeroEntries(J);CHKERRQ(ierr);
  ierr = SNESSetJacobian(snes_alg,J,J,AlgJacobian,&user);CHKERRQ(ierr);
  ierr = SNESSetOptionsPrefix(snes_alg,"alg_");CHKERRQ(ierr);
  ierr = SNESSetFromOptions(snes_alg);CHKERRQ(ierr);

  /* Apply disturbance - resistive fault at user.faultbus */
  /* This is done by adding shunt conductance to the diagonal location
     in the Ybus matrix */
  row_loc = 2*user.faultbus; col_loc = 2*user.faultbus+1; /* Location for G */
  val     = 1/user.Rfault;
  ierr    = MatSetValues(user.Ybus,1,&row_loc,1,&col_loc,&val,ADD_VALUES);CHKERRQ(ierr);
  row_loc = 2*user.faultbus+1; col_loc = 2*user.faultbus; /* Location for G */
  val     = 1/user.Rfault;
  ierr    = MatSetValues(user.Ybus,1,&row_loc,1,&col_loc,&val,ADD_VALUES);CHKERRQ(ierr);

  ierr = MatAssemblyBegin(user.Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
  ierr = MatAssemblyEnd(user.Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);

  user.alg_flg = PETSC_TRUE;
  /* Solve the algebraic equations */
  ierr = SNESSolve(snes_alg,NULL,X);CHKERRQ(ierr);


  /* Disturbance period */
  ierr = TSSetDuration(ts,1000,user.tfaultoff);CHKERRQ(ierr);
  ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
  ierr = TSSetInitialTimeStep(ts,user.tfaulton,.01);CHKERRQ(ierr);

  user.alg_flg = PETSC_FALSE;

  ierr = TSSolve(ts,X);CHKERRQ(ierr);

  /* Remove the fault */
  row_loc = 2*user.faultbus; col_loc = 2*user.faultbus+1;
  val     = -1/user.Rfault;
  ierr    = MatSetValues(user.Ybus,1,&row_loc,1,&col_loc,&val,ADD_VALUES);CHKERRQ(ierr);
  row_loc = 2*user.faultbus+1; col_loc = 2*user.faultbus;
  val     = -1/user.Rfault;
  ierr    = MatSetValues(user.Ybus,1,&row_loc,1,&col_loc,&val,ADD_VALUES);CHKERRQ(ierr);

  ierr = MatAssemblyBegin(user.Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
  ierr = MatAssemblyEnd(user.Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);

  ierr = MatZeroEntries(J);CHKERRQ(ierr);

  user.alg_flg = PETSC_TRUE;

  /* Solve the algebraic equations */
  ierr = SNESSolve(snes_alg,NULL,X);CHKERRQ(ierr);

  /* Post-disturbance period */
  ierr = TSSetDuration(ts,1000,user.tmax);CHKERRQ(ierr);
  ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
  ierr = TSSetInitialTimeStep(ts,user.tfaultoff,.01);CHKERRQ(ierr);

  user.alg_flg = PETSC_TRUE;

  ierr = TSSolve(ts,X);CHKERRQ(ierr);

  /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     Adjoint model starts here
     - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  ierr = TSSetPostStep(ts,NULL);CHKERRQ(ierr);
  ierr = MatCreateVecs(J,&lambda[0],NULL);CHKERRQ(ierr);
  /*   Set initial conditions for the adjoint integration */
  ierr = VecZeroEntries(lambda[0]);CHKERRQ(ierr);
  ierr = VecGetArray(lambda[0],&y_ptr);CHKERRQ(ierr);
  y_ptr[0] = 1.0;
  ierr = VecRestoreArray(lambda[0],&y_ptr);CHKERRQ(ierr);
  ierr = TSSetCostGradients(ts,1,lambda,NULL);CHKERRQ(ierr);

  ierr = TSAdjointSolve(ts);CHKERRQ(ierr);

  ierr = PetscPrintf(PETSC_COMM_WORLD,"\n sensitivity wrt initial conditions: \n");CHKERRQ(ierr);
  ierr = VecView(lambda[0],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
  ierr = VecDestroy(&lambda[0]);CHKERRQ(ierr);

  ierr = SNESDestroy(&snes_alg);CHKERRQ(ierr);
  ierr = VecDestroy(&F_alg);CHKERRQ(ierr);
  ierr = MatDestroy(&J);CHKERRQ(ierr);
  ierr = MatDestroy(&user.Ybus);CHKERRQ(ierr);
  ierr = VecDestroy(&X);CHKERRQ(ierr);
  ierr = VecDestroy(&user.V0);CHKERRQ(ierr);
  ierr = DMDestroy(&user.dmgen);CHKERRQ(ierr);
  ierr = DMDestroy(&user.dmnet);CHKERRQ(ierr);
  ierr = DMDestroy(&user.dmpgrid);CHKERRQ(ierr);
  ierr = ISDestroy(&user.is_diff);CHKERRQ(ierr);
  ierr = ISDestroy(&user.is_alg);CHKERRQ(ierr);
  ierr = TSDestroy(&ts);CHKERRQ(ierr);
  ierr = PetscFinalize();
  return ierr;
}
Exemple #6
0
int main(int argc,char **argv)
{
  TS             ts;
  SNES           snes_alg;
  PetscErrorCode ierr;
  PetscMPIInt    size;
  Userctx        user;
  PetscViewer    Xview,Ybusview;
  Vec            X;
  Mat            J;
  PetscInt       i;

  ierr = PetscInitialize(&argc,&argv,"petscoptions",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");

  user.neqs_gen   = 9*ngen; /* # eqs. for generator subsystem */
  user.neqs_net   = 2*nbus; /* # eqs. for network subsystem   */
  user.neqs_pgrid = user.neqs_gen + user.neqs_net;

  /* Create indices for differential and algebraic equations */
  PetscInt *idx2;
  ierr = PetscMalloc1(7*ngen,&idx2);CHKERRQ(ierr);
  for (i=0; i<ngen; i++) {
    idx2[7*i]   = 9*i;   idx2[7*i+1] = 9*i+1; idx2[7*i+2] = 9*i+2; idx2[7*i+3] = 9*i+3;
    idx2[7*i+4] = 9*i+6; idx2[7*i+5] = 9*i+7; idx2[7*i+6] = 9*i+8;
  }
  ierr = ISCreateGeneral(PETSC_COMM_WORLD,7*ngen,idx2,PETSC_COPY_VALUES,&user.is_diff);CHKERRQ(ierr);
  ierr = ISComplement(user.is_diff,0,user.neqs_pgrid,&user.is_alg);CHKERRQ(ierr);
  ierr = PetscFree(idx2);CHKERRQ(ierr);

  /* Read initial voltage vector and Ybus */
  ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"X.bin",FILE_MODE_READ,&Xview);CHKERRQ(ierr);
  ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"Ybus.bin",FILE_MODE_READ,&Ybusview);CHKERRQ(ierr);

  ierr = VecCreate(PETSC_COMM_WORLD,&user.V0);CHKERRQ(ierr);
  ierr = VecSetSizes(user.V0,PETSC_DECIDE,user.neqs_net);CHKERRQ(ierr);
  ierr = VecLoad(user.V0,Xview);CHKERRQ(ierr);

  ierr = MatCreate(PETSC_COMM_WORLD,&user.Ybus);CHKERRQ(ierr);
  ierr = MatSetSizes(user.Ybus,PETSC_DECIDE,PETSC_DECIDE,user.neqs_net,user.neqs_net);CHKERRQ(ierr);
  ierr = MatSetType(user.Ybus,MATBAIJ);CHKERRQ(ierr);
  /*  ierr = MatSetBlockSize(user.Ybus,2);CHKERRQ(ierr); */
  ierr = MatLoad(user.Ybus,Ybusview);CHKERRQ(ierr);

  /* Set run time options */
  ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"Transient stability fault options","");CHKERRQ(ierr);
  {
    user.tfaulton  = 1.0;
    user.tfaultoff = 1.2;
    user.Rfault    = 0.0001;
    user.faultbus  = 8;
    ierr           = PetscOptionsReal("-tfaulton","","",user.tfaulton,&user.tfaulton,NULL);CHKERRQ(ierr);
    ierr           = PetscOptionsReal("-tfaultoff","","",user.tfaultoff,&user.tfaultoff,NULL);CHKERRQ(ierr);
    ierr           = PetscOptionsInt("-faultbus","","",user.faultbus,&user.faultbus,NULL);CHKERRQ(ierr);
    user.t0        = 0.0;
    user.tmax      = 5.0;
    ierr           = PetscOptionsReal("-t0","","",user.t0,&user.t0,NULL);CHKERRQ(ierr);
    ierr           = PetscOptionsReal("-tmax","","",user.tmax,&user.tmax,NULL);CHKERRQ(ierr);
  }
  ierr = PetscOptionsEnd();CHKERRQ(ierr);

  ierr = PetscViewerDestroy(&Xview);CHKERRQ(ierr);
  ierr = PetscViewerDestroy(&Ybusview);CHKERRQ(ierr);

  /* Create DMs for generator and network subsystems */
  ierr = DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,user.neqs_gen,1,1,NULL,&user.dmgen);CHKERRQ(ierr);
  ierr = DMSetOptionsPrefix(user.dmgen,"dmgen_");CHKERRQ(ierr);
  ierr = DMDACreate1d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,user.neqs_net,1,1,NULL,&user.dmnet);CHKERRQ(ierr);
  ierr = DMSetOptionsPrefix(user.dmnet,"dmnet_");CHKERRQ(ierr);
  /* Create a composite DM packer and add the two DMs */
  ierr = DMCompositeCreate(PETSC_COMM_WORLD,&user.dmpgrid);CHKERRQ(ierr);
  ierr = DMSetOptionsPrefix(user.dmpgrid,"pgrid_");CHKERRQ(ierr);
  ierr = DMCompositeAddDM(user.dmpgrid,user.dmgen);CHKERRQ(ierr);
  ierr = DMCompositeAddDM(user.dmpgrid,user.dmnet);CHKERRQ(ierr);

  ierr = DMCreateGlobalVector(user.dmpgrid,&X);CHKERRQ(ierr);

  ierr = MatCreate(PETSC_COMM_WORLD,&J);CHKERRQ(ierr);
  ierr = MatSetSizes(J,PETSC_DECIDE,PETSC_DECIDE,user.neqs_pgrid,user.neqs_pgrid);CHKERRQ(ierr);
  ierr = MatSetFromOptions(J);CHKERRQ(ierr);
  ierr = PreallocateJacobian(J,&user);CHKERRQ(ierr);

  /* Create matrix to save solutions at each time step */
  user.stepnum = 0;

  ierr = MatCreateSeqDense(PETSC_COMM_SELF,user.neqs_pgrid+1,1002,NULL,&user.Sol);CHKERRQ(ierr);
  /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     Create timestepping solver context
     - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
  ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
  ierr = TSSetEquationType(ts,TS_EQ_DAE_IMPLICIT_INDEX1);CHKERRQ(ierr);
  ierr = TSARKIMEXSetFullyImplicit(ts,PETSC_TRUE);CHKERRQ(ierr);
  ierr = TSSetIFunction(ts,NULL,(TSIFunction) IFunction,&user);CHKERRQ(ierr);
  ierr = TSSetIJacobian(ts,J,J,(TSIJacobian)IJacobian,&user);CHKERRQ(ierr);
  ierr = TSSetApplicationContext(ts,&user);CHKERRQ(ierr);

  /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     Set initial conditions
   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  ierr = SetInitialGuess(X,&user);CHKERRQ(ierr);
  /* Just to set up the Jacobian structure */
  Vec          Xdot;
  MatStructure flg;
  ierr = VecDuplicate(X,&Xdot);CHKERRQ(ierr);
  ierr = IJacobian(ts,0.0,X,Xdot,0.0,J,J,&flg,&user);CHKERRQ(ierr);
  ierr = VecDestroy(&Xdot);CHKERRQ(ierr);

  /* Save initial solution */
  PetscScalar *x,*mat;
  PetscInt idx=user.stepnum*(user.neqs_pgrid+1);
  ierr = MatDenseGetArray(user.Sol,&mat);CHKERRQ(ierr);
  ierr = VecGetArray(X,&x);CHKERRQ(ierr);

  mat[idx] = 0.0;

  ierr = PetscMemcpy(mat+idx+1,x,user.neqs_pgrid*sizeof(PetscScalar));CHKERRQ(ierr);
  ierr = MatDenseRestoreArray(user.Sol,&mat);CHKERRQ(ierr);
  ierr = VecRestoreArray(X,&x);CHKERRQ(ierr);
  user.stepnum++;

  ierr = TSSetDuration(ts,1000,user.tfaulton);CHKERRQ(ierr);
  ierr = TSSetInitialTimeStep(ts,0.0,0.01);CHKERRQ(ierr);
  ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
  ierr = TSSetPostStep(ts,SaveSolution);CHKERRQ(ierr);

  user.alg_flg = PETSC_FALSE;
  /* Prefault period */
  ierr = TSSolve(ts,X);CHKERRQ(ierr);

  /* Create the nonlinear solver for solving the algebraic system */
  /* Note that although the algebraic system needs to be solved only for
     Idq and V, we reuse the entire system including xgen. The xgen
     variables are held constant by setting their residuals to 0 and
     putting a 1 on the Jacobian diagonal for xgen rows
  */
  Vec F_alg;
  ierr = VecDuplicate(X,&F_alg);CHKERRQ(ierr);
  ierr = SNESCreate(PETSC_COMM_WORLD,&snes_alg);CHKERRQ(ierr);
  ierr = SNESSetFunction(snes_alg,F_alg,AlgFunction,&user);CHKERRQ(ierr);
  ierr = MatZeroEntries(J);CHKERRQ(ierr);
  ierr = SNESSetJacobian(snes_alg,J,J,AlgJacobian,&user);CHKERRQ(ierr);
  ierr = SNESSetOptionsPrefix(snes_alg,"alg_");CHKERRQ(ierr);
  ierr = SNESSetFromOptions(snes_alg);CHKERRQ(ierr);

  /* Apply disturbance - resistive fault at user.faultbus */
  /* This is done by adding shunt conductance to the diagonal location
     in the Ybus matrix */
  PetscInt    row_loc,col_loc;
  PetscScalar val;
  row_loc = 2*user.faultbus; col_loc = 2*user.faultbus+1; /* Location for G */
  val     = 1/user.Rfault;
  ierr    = MatSetValues(user.Ybus,1,&row_loc,1,&col_loc,&val,ADD_VALUES);CHKERRQ(ierr);
  row_loc = 2*user.faultbus+1; col_loc = 2*user.faultbus; /* Location for G */
  val     = 1/user.Rfault;
  ierr    = MatSetValues(user.Ybus,1,&row_loc,1,&col_loc,&val,ADD_VALUES);CHKERRQ(ierr);

  ierr = MatAssemblyBegin(user.Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
  ierr = MatAssemblyEnd(user.Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);

  user.alg_flg = PETSC_TRUE;
  /* Solve the algebraic equations */
  ierr = SNESSolve(snes_alg,NULL,X);CHKERRQ(ierr);

  /* Save fault-on solution */
  idx      = user.stepnum*(user.neqs_pgrid+1);
  ierr     = MatDenseGetArray(user.Sol,&mat);CHKERRQ(ierr);
  ierr     = VecGetArray(X,&x);CHKERRQ(ierr);
  mat[idx] = user.tfaulton;
  ierr     = PetscMemcpy(mat+idx+1,x,user.neqs_pgrid*sizeof(PetscScalar));CHKERRQ(ierr);
  ierr     = MatDenseRestoreArray(user.Sol,&mat);CHKERRQ(ierr);
  ierr     = VecRestoreArray(X,&x);CHKERRQ(ierr);
  user.stepnum++;

  /* Disturbance period */
  ierr = TSSetDuration(ts,1000,user.tfaultoff);CHKERRQ(ierr);
  ierr = TSSetInitialTimeStep(ts,user.tfaulton,.01);CHKERRQ(ierr);

  user.alg_flg = PETSC_FALSE;

  ierr = TSSolve(ts,X);CHKERRQ(ierr);

  /* Remove the fault */
  row_loc = 2*user.faultbus; col_loc = 2*user.faultbus+1;
  val     = -1/user.Rfault;
  ierr    = MatSetValues(user.Ybus,1,&row_loc,1,&col_loc,&val,ADD_VALUES);CHKERRQ(ierr);
  row_loc = 2*user.faultbus+1; col_loc = 2*user.faultbus;
  val     = -1/user.Rfault;
  ierr    = MatSetValues(user.Ybus,1,&row_loc,1,&col_loc,&val,ADD_VALUES);CHKERRQ(ierr);

  ierr = MatAssemblyBegin(user.Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
  ierr = MatAssemblyEnd(user.Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);

  ierr = MatZeroEntries(J);CHKERRQ(ierr);

  user.alg_flg = PETSC_TRUE;

  /* Solve the algebraic equations */
  ierr = SNESSolve(snes_alg,NULL,X);CHKERRQ(ierr);

  /* Save tfault off solution */
  idx      = user.stepnum*(user.neqs_pgrid+1);
  ierr     = MatDenseGetArray(user.Sol,&mat);CHKERRQ(ierr);
  ierr     = VecGetArray(X,&x);CHKERRQ(ierr);
  mat[idx] = user.tfaultoff;
  ierr     = PetscMemcpy(mat+idx+1,x,user.neqs_pgrid*sizeof(PetscScalar));CHKERRQ(ierr);
  ierr     = MatDenseRestoreArray(user.Sol,&mat);CHKERRQ(ierr);
  ierr     = VecRestoreArray(X,&x);CHKERRQ(ierr);
  user.stepnum++;

  /* Post-disturbance period */
  ierr = TSSetDuration(ts,1000,user.tmax);CHKERRQ(ierr);
  ierr = TSSetInitialTimeStep(ts,user.tfaultoff,.01);CHKERRQ(ierr);

  user.alg_flg = PETSC_TRUE;

  ierr = TSSolve(ts,X);CHKERRQ(ierr);

  ierr = MatAssemblyBegin(user.Sol,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
  ierr = MatAssemblyEnd(user.Sol,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);

  Mat         A;
  PetscScalar *amat;
  ierr = MatCreateSeqDense(PETSC_COMM_SELF,user.neqs_pgrid+1,user.stepnum,NULL,&A);CHKERRQ(ierr);
  ierr = MatDenseGetArray(user.Sol,&mat);CHKERRQ(ierr);
  ierr = MatDenseGetArray(A,&amat);CHKERRQ(ierr);
  ierr = PetscMemcpy(amat,mat,(user.stepnum*(user.neqs_pgrid+1))*sizeof(PetscScalar));CHKERRQ(ierr);
  ierr = MatDenseRestoreArray(A,&amat);CHKERRQ(ierr);
  ierr = MatDenseRestoreArray(user.Sol,&mat);CHKERRQ(ierr);
  PetscViewer viewer;
  ierr = PetscViewerBinaryOpen(PETSC_COMM_SELF,"out.bin",FILE_MODE_WRITE,&viewer);CHKERRQ(ierr);
  ierr = MatView(A,viewer);CHKERRQ(ierr);
  ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
  ierr = MatDestroy(&A);CHKERRQ(ierr);
  ierr = SNESDestroy(&snes_alg);CHKERRQ(ierr);
  ierr = VecDestroy(&F_alg);CHKERRQ(ierr);
  ierr = MatDestroy(&J);CHKERRQ(ierr);
  ierr = MatDestroy(&user.Ybus);CHKERRQ(ierr);
  ierr = MatDestroy(&user.Sol);CHKERRQ(ierr);
  ierr = VecDestroy(&X);CHKERRQ(ierr);
  ierr = VecDestroy(&user.V0);CHKERRQ(ierr);
  ierr = DMDestroy(&user.dmgen);CHKERRQ(ierr);
  ierr = DMDestroy(&user.dmnet);CHKERRQ(ierr);
  ierr = DMDestroy(&user.dmpgrid);CHKERRQ(ierr);
  ierr = ISDestroy(&user.is_diff);CHKERRQ(ierr);
  ierr = ISDestroy(&user.is_alg);CHKERRQ(ierr);
  ierr = TSDestroy(&ts);CHKERRQ(ierr);
  ierr = PetscFinalize();
  return(0);
}
PetscErrorCode InitializeData(const PetscScalar* P, void *ctx0, double noise, PetscScalar data_dt)
{
  TS             ts;
  SNES           snes_alg;
  PetscErrorCode ierr;
  Userctx        *ctx = (Userctx*)ctx0;
  Vec            X;
  Mat            J;
  Vec            F_alg;
  Vec            Xdot;
  PetscInt       i,j,m,n;
  PetscReal      *mat;
  //PetscReal      temp;
  PetscViewer    obsView;

  PetscFunctionBegin;

  H[0] = P[0];
  H[1] = P[1];
  H[2] = P[2];
  printf("InitializeData: x=[%.14f, %.14f, %.14f], obs_noise=%5.3f Nt = %4.2f, Nobs=%4.2f\n",  H[0],  H[1], H[2], noise, ((ctx->tfinal-ctx->t0)/ctx->dt)+1, ((ctx->tfinal-ctx->trestore)/ctx->data_dt)+1);

  if(ctx->t0 > ctx->tdisturb) {
    printf("t0 cannot be greater than tdisturb\n");
    PetscFunctionReturn(-1);
  }
  if( (ctx->tdisturb >= ctx->trestore-1.0e-8) || (ctx->tdisturb >= ctx->tfinal-1.0e-8) ) {
    printf("tdisturb should be less than trestore and tfinal\n");
    PetscFunctionReturn(-1);
  }

  //use the reference PD0 from t0 to t_disturb to ensure steady state
  for(i=0; i<3; i++) PD0[i] = PD0_ref[i];

  ctx->stepnum = 0;

  ierr = DMCreateGlobalVector(ctx->dmpgrid,&X);CHKERRQ(ierr);

  ierr = MatCreate(PETSC_COMM_WORLD,&J);CHKERRQ(ierr);
  ierr = MatSetSizes(J,PETSC_DECIDE,PETSC_DECIDE,ctx->neqs_pgrid,ctx->neqs_pgrid);CHKERRQ(ierr);
  ierr = MatSetFromOptions(J);CHKERRQ(ierr);
  ierr = PreallocateJacobian(J,ctx);CHKERRQ(ierr);

  /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     Create timestepping solver context
     - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
  ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
  ierr = TSSetType(ts,TSCN);CHKERRQ(ierr);
  ierr = TSSetIFunction(ts,NULL,(TSIFunction) IFunction,ctx);CHKERRQ(ierr);
  ierr = TSSetIJacobian(ts,J,J,(TSIJacobian)IJacobian,ctx);CHKERRQ(ierr);
  ierr = TSSetApplicationContext(ts,ctx);CHKERRQ(ierr);

  /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     Set initial conditions
   - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  ierr = SetInitialGuess(X,ctx);CHKERRQ(ierr);

  ierr = VecDuplicate(X,&F_alg);CHKERRQ(ierr);
  ierr = SNESCreate(PETSC_COMM_WORLD,&snes_alg);CHKERRQ(ierr);
  ierr = SNESSetFunction(snes_alg,F_alg,AlgFunction,ctx);CHKERRQ(ierr);
  ierr = MatZeroEntries(J);CHKERRQ(ierr);
  ierr = SNESSetJacobian(snes_alg,J,J,AlgJacobian,ctx);CHKERRQ(ierr);
  ierr = SNESSetOptionsPrefix(snes_alg,"alg_");CHKERRQ(ierr);
  ierr = SNESSetFromOptions(snes_alg);CHKERRQ(ierr);
  /* Solve the algebraic equations */
  ierr = SNESSolve(snes_alg,NULL,X);CHKERRQ(ierr);

  ierr = SetSolution(ctx, ctx->t0, X); CHKERRQ(ierr);
  ierr = SetObservation(ctx, ctx->t0, X); CHKERRQ(ierr);


  /* Just to set up the Jacobian structure */
  ierr = VecDuplicate(X,&Xdot);CHKERRQ(ierr);
  ierr = IJacobian(ts,ctx->t0,X,Xdot,0.0,J,J,ctx);CHKERRQ(ierr);
  ierr = VecDestroy(&Xdot);CHKERRQ(ierr);

  /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     Solve from on [t0,tdisturb] (steady state)
     - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  ierr = TSSetDuration(ts,1000000,ctx->tdisturb);CHKERRQ(ierr);
  ierr = TSSetInitialTimeStep(ts,ctx->t0,ctx->dt);CHKERRQ(ierr);
  ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
  ierr = TSSetPostStep(ts,SaveObservation);CHKERRQ(ierr);
  /* Solve (from t0 to tdisturb) */
  ierr = TSSolve(ts,X);CHKERRQ(ierr);

  /* set X at tdisturb as IC for the  optimization/estimation */
  /*ierr = VecDuplicate(X, &ctx->X0_disturb);CHKERRQ(ierr);*/
  /*ierr = VecCopy(X, ctx->X0_disturb);CHKERRQ(ierr);*/

  /* Continue integrating the DAE only if observations file is not specified */


  /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     Solve from on [tdisturb, trestore] (disturbance part of the transient)
     - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  /* Induce a load perturbation at t=tdisturb */
  for(i=0; i<3; i++) PD0[i] = PD0_disturb[i];
  
  printf("Generate data - initiated a bump in load: new PD0[0]=%g\n", PD0[0]);
  printf("Running with: tfinal=%.12f dt=%.12f data_dt=%.12f data_noise=%.12f prior_noise=%.12f load_disturb=%.12f\n",
	 ctx->tfinal, ctx->dt, ctx->data_dt,
	 ctx->data_noise, ctx->prior_noise, PD0[0]);

  /* Solve the algebraic equations  */
  ierr = SNESSolve(snes_alg,NULL,X);CHKERRQ(ierr);
  
  ierr = TSSetDuration(ts,100000,fmin(ctx->trestore,ctx->tfinal));CHKERRQ(ierr);
  ierr = TSSetInitialTimeStep(ts,ctx->tdisturb,ctx->dt);CHKERRQ(ierr);
  /* Solve (from tdisturb to trestore) */
  ierr = TSSolve(ts,X);CHKERRQ(ierr);

  /* set X at trestore as IC for the  optimization/estimation */
  ierr = VecDuplicate(X, &ctx->X0_disturb);CHKERRQ(ierr);
  ierr = VecCopy(X, ctx->X0_disturb);CHKERRQ(ierr);

  
  if(0==strlen(ctx->loadObsFile)) {
    /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
       Solve from on [trestore, tfinal] (post-disturbance transient)
       - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
    if(ctx->tfinal>=ctx->trestore+1.0e-8) {
      //restore  load at trestore
      for(i=0; i<3; i++) PD0[i] = PD0_ref[i];
      
      printf("In generate data: Restore load to PD0[0]=%g\n", PD0[0]);
      
      /* Solve the algebraic equations  */
      ierr = SNESSolve(snes_alg,NULL,X);CHKERRQ(ierr);
      
      ierr = TSSetDuration(ts,100000,ctx->tfinal);CHKERRQ(ierr);
      ierr = TSSetInitialTimeStep(ts,ctx->trestore,ctx->dt);CHKERRQ(ierr);
      /* Solve (from trestore to tfinal) */
      ierr = TSSolve(ts,X);CHKERRQ(ierr);
    } else {
      printf("Ignoring trestore since tfinal is less than it.\n");
    }
    
    /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
       Generate noise at level 'noise' percent
       - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
    ierr = MatGetSize(ctx->obs, &m, &n);CHKERRQ(ierr);
    /* allocate std dev for data */
    ierr = PetscMalloc(m*sizeof(PetscReal),&ctx->data_stddev);CHKERRQ(ierr);
    ierr = MatDenseGetArray(ctx->obs,&mat);CHKERRQ(ierr);
    
    for(i=0;i<m;i++)
      ctx->data_stddev[i] = ctx->data_noise;
    
    /*  for(i=0; i<m; i++) {
	temp = 0.0;
	for(j=0; j<n; j++) {
	temp += mat[i*n+j]*mat[i*n+j];
	}
	ctx->data_stddev[i] = ctx->data_noise*sqrt(temp);
	}
    */
    
    for(i=0; i<m; i++) {
      for(j=0; j<n; j++) {
	mat[i*n+j] +=  ctx->data_stddev[i]*nrand();
      }
    }
    
    ierr = MatDenseRestoreArray(ctx->obs,&mat);CHKERRQ(ierr);
  } else {
    /* observations are in an external file */
    printf("Loading observations from %s.\n", ctx->loadObsFile);

    ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,ctx->loadObsFile,FILE_MODE_READ, &obsView);CHKERRQ(ierr);
    ierr = MatLoad(ctx->obs, obsView);CHKERRQ(ierr);
    ierr = PetscViewerDestroy(&obsView);CHKERRQ(ierr);

    ierr = MatGetSize(ctx->obs, &m, &n);CHKERRQ(ierr);
    ierr = PetscMalloc(m*sizeof(PetscReal),&ctx->data_stddev);CHKERRQ(ierr);
    for(i=0;i<m;i++)
      ctx->data_stddev[i] = ctx->data_noise;
  }

  ierr = SNESDestroy(&snes_alg);CHKERRQ(ierr);
  ierr = VecDestroy(&F_alg);CHKERRQ(ierr);
  ierr = MatDestroy(&J);CHKERRQ(ierr);
  ierr = VecDestroy(&X);CHKERRQ(ierr);
  ierr = TSDestroy(&ts);CHKERRQ(ierr);

  PetscFunctionReturn(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
   G   - the newly evaluated gradient
*/
PetscErrorCode FormFunctionGradient(Tao tao,Vec P,PetscReal *f,Vec G,void *ctx0)
{
  TS             ts;
  PetscErrorCode ierr;
  Userctx        *ctx = (Userctx*)ctx0;
  Vec            X, F_alg;
  SNES           snes_alg;
  PetscScalar    *x_ptr;
  Vec            lambda[1];
  //Vec            q;
  Vec            mu[1];
  PetscInt       steps,steps3;
  PetscReal      t,t2;
  Vec            Xdot;
  /* FD check */
  PetscReal      f1,f2,expo;
  Vec            Pvec_eps;
  PetscReal*     P_eps;
  PetscInt i;
  PetscBool fd;
  Vec Xdist_final;

  printf("aaa\n");

  ierr  = VecGetArray(P,&x_ptr);CHKERRQ(ierr);
  H[0] = x_ptr[0];
  H[1] = x_ptr[1];
  H[2] = x_ptr[2];
  //printf("FormFunctionGradient: x=[%.14f, %.14f, %.14f]\n",  x_ptr[0],  x_ptr[1], x_ptr[2]);
  //printf("FormFunctionGradient - PD0[0]=%g\n", PD0[0]);
  ierr  = VecRestoreArray(P,&x_ptr);CHKERRQ(ierr);

  if(ctx->t0 > ctx->tdisturb) {
    printf("t0 cannot be greater than tdisturb\n");
    PetscFunctionReturn(-1);
  }
  if( (ctx->tdisturb >= ctx->trestore-1.0e-8) || (ctx->tdisturb >= ctx->tfinal-1.0e-8) ) {
    printf("tdisturb should be less than trestore and tfinal\n");
    PetscFunctionReturn(-1);
  }

  ctx->misfit=0.0;
  ctx->stepnum = 0;

  ierr = VecZeroEntries(ctx->vec_q);CHKERRQ(ierr);
  ierr = DMCreateGlobalVector(ctx->dmpgrid,&X);CHKERRQ(ierr);


  /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     Create timestepping solver context
     - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
  ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
  ierr = TSSetType(ts,TSCN);CHKERRQ(ierr);
  ierr = TSSetIFunction(ts,NULL,(TSIFunction) IFunction,ctx);CHKERRQ(ierr);
  ierr = TSSetIJacobian(ts,ctx->J,ctx->J,(TSIJacobian)IJacobian,ctx);CHKERRQ(ierr);
  ierr = TSSetApplicationContext(ts,ctx);CHKERRQ(ierr);

  /* Set initial conditions */
  ierr = VecCopy(ctx->X0_disturb, X);CHKERRQ(ierr);

  /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     Solve from on [tdisturb, trestore] (disturbance part of the transient)
     - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

  /* Induce a load perturbation at t=tdisturb */
  //!for(i=0; i<3; i++) PD0[i] = PD0_disturb[i];

  /* Induce a load perturbation at t=trestore*/
  for(i=0; i<3; i++) PD0[i] = PD0_ref[i];
  //!printf("In FormFunctionGradien: Induce a load perturbance to PD0[0]=%g\n", PD0[0]);

  /* Solve for algebraic variables with Xgen given by X0_disturb */
  ierr = VecDuplicate(X,&F_alg);CHKERRQ(ierr);
  ierr = SNESCreate(PETSC_COMM_WORLD,&snes_alg);CHKERRQ(ierr);
  ierr = SNESSetFunction(snes_alg,F_alg,AlgFunction,ctx);CHKERRQ(ierr);
  ierr = MatZeroEntries(ctx->J);CHKERRQ(ierr);
  ierr = SNESSetJacobian(snes_alg,ctx->J,ctx->J,AlgJacobian,ctx);CHKERRQ(ierr);
  ierr = SNESSetOptionsPrefix(snes_alg,"alg_");CHKERRQ(ierr);
  ierr = SNESSetFromOptions(snes_alg);CHKERRQ(ierr);
  /* Solve the algebraic equations */
  ierr = SNESSolve(snes_alg,NULL,X);CHKERRQ(ierr);

  /* Just to set up the Jacobian structure */
  ierr = VecDuplicate(X,&Xdot);CHKERRQ(ierr);
  //!  ierr = IJacobian(ts,ctx->tdisturb,X,Xdot,0.0,ctx->J,ctx->J,ctx);CHKERRQ(ierr);
  ierr = IJacobian(ts,ctx->trestore,X,Xdot,0.0,ctx->J,ctx->J,ctx);CHKERRQ(ierr);
  ierr = VecDestroy(&Xdot);CHKERRQ(ierr);

  /* Save trajectory of solution so that TSAdjointSolve() may be used */
  ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr);

  /* Hook up the function evaluation */
  ierr = TSSetPostStep(ts,EvalMisfit);CHKERRQ(ierr);

  //!ierr = TSSetDuration(ts,10000,fmin(ctx->trestore,ctx->tfinal));CHKERRQ(ierr);
  ierr = TSSetDuration(ts,10000,ctx->tfinal);CHKERRQ(ierr);
  //!ierr = TSSetInitialTimeStep(ts,ctx->tdisturb,ctx->dt);CHKERRQ(ierr);
  ierr = TSSetInitialTimeStep(ts,ctx->trestore,ctx->dt);CHKERRQ(ierr);
  ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
  /* Solve the forward problem */
  //printf("Forward solve...\n");
  ierr = TSSolve(ts,X);CHKERRQ(ierr);

  ierr = VecDuplicate(X, &Xdist_final);CHKERRQ(ierr);
  ierr = VecCopy(X, Xdist_final);CHKERRQ(ierr);
  /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     Solve from on [trestore, tfinal] (post-disturbance transient)
     - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

  /* if(ctx->tfinal>=ctx->trestore+1.0e-8) { */
  /*   //restore  load at trestore */
  /*   for(i=0; i<3; i++) PD0[i] = PD0_ref[i]; */
    
  /*   printf("In FormFunctionGradien: Restore load to PD0[0]=%g\n", PD0[0]); */
    
  /*   /\* Solve the algebraic equations  *\/ */
  /*   ierr = SNESSolve(snes_alg,NULL,X);CHKERRQ(ierr); */
    
  /*   ierr = TSSetDuration(ts,100000,ctx->tfinal);CHKERRQ(ierr); */
  /*   ierr = TSSetInitialTimeStep(ts,ctx->trestore,ctx->dt);CHKERRQ(ierr); */
  /*   /\* Solve (from trestore to tfinal) *\/ */
  /*   ierr = TSSolve(ts,X);CHKERRQ(ierr); */
  /* } else { */
  /*   printf("Ignoring trestore since tfinal is less than it.\n"); */
  /* } */




  /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     Adjoint model starts here
     - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  ierr = TSGetTimeStepNumber(ts,&steps3);CHKERRQ(ierr);
  ierr = TSSetPostStep(ts,NULL);CHKERRQ(ierr);

  ierr = MatCreateVecs(ctx->J,&lambda[0],NULL);CHKERRQ(ierr);

  /*   Set initial conditions for the adjoint integration */
  ierr = VecZeroEntries(lambda[0]);CHKERRQ(ierr);

  ierr = MatCreateVecs(ctx->Jacp,&mu[0],NULL);CHKERRQ(ierr);

  ierr = VecZeroEntries(mu[0]);CHKERRQ(ierr);

  /* Sets the initial value of the gradients of the cost w.r.t. x_0 and p */
  /*  Notes: the entries in these vectors must be correctly initialized */
  /* with the values lambda_i = df/dy|finaltime mu_i = df/dp|finaltime */
  ierr = TSSetCostGradients(ts,1,lambda,mu);CHKERRQ(ierr);

  /* Sets the function that computes the Jacobian of f w.r.t. p where x_t = f(x,y,p,t) */
  ierr = TSAdjointSetRHSJacobian(ts,ctx->Jacp,RHSJacobianP,ctx);CHKERRQ(ierr);

  /* Sets the routine for evaluating the integral term in the cost */
  /*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,ctx);
  */
  ierr = TSSetCostIntegrand(ts,1,
			    NULL,
			    (PetscErrorCode (*)(TS,PetscReal,Vec,Vec*,void*))DRDYFunction,
			    (PetscErrorCode (*)(TS,PetscReal,Vec,Vec*,void*))DRDPFunction,ctx);
  CHKERRQ(ierr);

  t = ctx->tfinal;
  steps = (PetscInt)round(ctx->data_dt/ctx->dt);
  while(fabs(t-ctx->trestore)>1e-8)
  {
    ierr = TSGetTime(ts, &t2);CHKERRQ(ierr);

    /* Induce the perturbation in load accordingly corresponding to this time */
    if(t2-ctx->trestore>=-1e-8)
      for(i=0; i<3; i++) PD0[i] = PD0_ref[i];
    /* else if(t2-ctx->tdisturb>=0) */
    /*   for(i=0; i<3; i++) PD0[i] = PD0_disturb[i]; */
    else {printf("Panic: should not get here\n"); PetscFunctionReturn(-1);}

    /* Initial conditions for the adjoint */
    /* lambda += dr/dy */
    ierr = TSGetSolution(ts,&X);CHKERRQ(ierr);
          
    ierr = AddDRDY(t2,X,&lambda[0],ctx);CHKERRQ(ierr);
    
    //printf("Manual adjoint backward integration steps=%d t=%g t2=%g \n", steps, t, t2);
    /* Sets # steps the adjoint solver should take backward in time*/
    ierr = TSAdjointSetSteps(ts,steps);CHKERRQ(ierr);

    /* Solves the discrete adjoint problem for an ODE/DAE */
    ierr = TSAdjointSolve(ts);CHKERRQ(ierr);

    t -= steps * ctx->dt;
  }

  //printf("mu-FunctionGradient after Adjoint (t=%g)\n",t);
  //ierr = VecView(mu[0],PETSC_VIEWER_STDOUT_SELF);
  //ierr = VecView(lambda[0],PETSC_VIEWER_STDOUT_SELF);

  /* return gradient */
  ierr = VecCopy(mu[0],G);CHKERRQ(ierr);
  ierr = AddRegGradient(ctx,P,G);

  //ierr = VecView(G,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);

  /* return fcn eval */
  *f  = ctx->misfit;
  EvalReg(ctx, P);
  *f += ctx->prior;
  //printf("objective=%.12f\n", *f);
  
  /* Finalize: destroy */
  ierr = VecDestroy(&lambda[0]);CHKERRQ(ierr);
  ierr = VecDestroy(&mu[0]);CHKERRQ(ierr);
  ierr = VecDestroy(&X);CHKERRQ(ierr);
  ierr = VecDestroy(&F_alg);CHKERRQ(ierr);
  ierr = SNESDestroy(&snes_alg);CHKERRQ(ierr);
  ierr = TSDestroy(&ts);CHKERRQ(ierr);
  //printf("Adjoint ends\n");

  fd=0;
  if(fd) {
    /* FD check */
    ierr =  FormFunction(tao,P,&f1,ctx); CHKERRQ(ierr);
    printf("cost=%.12f \n",f1);
    ierr = VecDuplicate(P, &Pvec_eps); CHKERRQ(ierr);

    for(i=0; i<3; i++) {
      for(expo=1e-2; expo>1e-8; expo/=3) {

	ierr = VecCopy(P, Pvec_eps); CHKERRQ(ierr);

	ierr = VecGetArray(Pvec_eps, &P_eps); CHKERRQ(ierr);

	P_eps[i] += expo;
	ierr = VecRestoreArray(Pvec_eps, &P_eps); CHKERRQ(ierr);

	//ierr = VecView(Pvec_eps,PETSC_VIEWER_STDOUT_SELF);

	ierr =  FormFunction(tao,Pvec_eps,&f2,ctx); CHKERRQ(ierr);
	printf("fd[%d]=%12.6e f1=%.7e f2=%.7e expo=%g\n", i+1, (f2-f1)/expo, f1, f2, expo);
      }
    }
    ierr = VecDestroy(&Pvec_eps); CHKERRQ(ierr); 
    /* ~end of FD */
  }
  //PetscFunctionReturn(-1);
  PetscFunctionReturn(0);
}