예제 #1
0
파일: ex9busopt_fd.c 프로젝트: wgapl/petsc
/*
   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)
{
  TS             ts;
  SNES           snes_alg;
  PetscErrorCode ierr;
  Userctx        *ctx = (Userctx*)ctx0;
  Vec            X;
  Mat            J;
  /* sensitivity context */
  PetscScalar    *x_ptr;
  PetscViewer    Xview,Ybusview;
  Vec            F_alg;
  Vec            Xdot;
  PetscInt       row_loc,col_loc;
  PetscScalar    val;

  ierr  = VecGetArray(P,&x_ptr);CHKERRQ(ierr);
  PG[0] = x_ptr[0];
  PG[1] = x_ptr[1];
  PG[2] = x_ptr[2];
  ierr  = VecRestoreArray(P,&x_ptr);CHKERRQ(ierr);

  ctx->stepnum = 0;

  ierr = VecZeroEntries(ctx->vec_q);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,&ctx->V0);CHKERRQ(ierr);
  ierr = VecSetSizes(ctx->V0,PETSC_DECIDE,ctx->neqs_net);CHKERRQ(ierr);
  ierr = VecLoad(ctx->V0,Xview);CHKERRQ(ierr);

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

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

  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);

  ierr = TSMonitorSet(ts,MonitorUpdateQ,ctx,NULL);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);
  ctx->alg_flg = PETSC_TRUE;
  /* 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,0.0,X,Xdot,0.0,J,J,ctx);CHKERRQ(ierr);
  ierr = VecDestroy(&Xdot);CHKERRQ(ierr);

  ctx->stepnum++;

  ierr = TSSetDuration(ts,1000,ctx->tfaulton);CHKERRQ(ierr);
  ierr = TSSetInitialTimeStep(ts,0.0,0.01);CHKERRQ(ierr);
  ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
  /* ierr = TSSetPostStep(ts,SaveSolution);CHKERRQ(ierr); */

  ctx->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 = MatZeroEntries(J);CHKERRQ(ierr);

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

  ierr = MatAssemblyBegin(ctx->Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
  ierr = MatAssemblyEnd(ctx->Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);

  ctx->alg_flg = PETSC_TRUE;
  /* Solve the algebraic equations */
  ierr = SNESSolve(snes_alg,NULL,X);CHKERRQ(ierr);

  ctx->stepnum++;

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

  ctx->alg_flg = PETSC_FALSE;

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

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

  ierr = MatAssemblyBegin(ctx->Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
  ierr = MatAssemblyEnd(ctx->Ybus,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);

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

  ctx->alg_flg = PETSC_TRUE;

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

  ctx->stepnum++;

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

  ctx->alg_flg = PETSC_TRUE;

  ierr = TSSolve(ts,X);CHKERRQ(ierr);
  ierr = VecGetArray(ctx->vec_q,&x_ptr);CHKERRQ(ierr);
  *f   = x_ptr[0];
  ierr = VecRestoreArray(ctx->vec_q,&x_ptr);CHKERRQ(ierr);

  ierr = MatDestroy(&ctx->Ybus);CHKERRQ(ierr);
  ierr = VecDestroy(&ctx->V0);CHKERRQ(ierr);
  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);

  return 0;
}
예제 #2
0
파일: ex9busadj.c 프로젝트: tom-klotz/petsc
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;
}
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);
}
예제 #4
0
파일: ex9bus.c 프로젝트: 00liujj/petsc
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);
}
/*
   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);
}