/* Defines the ODE passed to the ODE solver */ static PetscErrorCode IFunction(TS ts,PetscReal t,Vec U,Vec Udot,Vec F,AppCtx *user) { PetscErrorCode ierr; PetscScalar *f,wm,Pw,*wd; const PetscScalar *u,*udot; PetscInt stepnum; PetscFunctionBegin; ierr = TSGetStepNumber(ts,&stepnum);CHKERRQ(ierr); /* The next three lines allow us to access the entries of the vectors directly */ ierr = VecGetArrayRead(U,&u);CHKERRQ(ierr); ierr = VecGetArrayRead(Udot,&udot);CHKERRQ(ierr); ierr = VecGetArray(F,&f);CHKERRQ(ierr); ierr = VecGetArray(user->wind_data,&wd);CHKERRQ(ierr); f[0] = user->Tw*udot[0] - wd[stepnum] + u[0]; wm = 1-u[1]; ierr = GetWindPower(wm,u[0],&Pw,user);CHKERRQ(ierr); f[1] = 2.0*(user->Ht+user->Hm)*udot[1] - Pw/wm + user->Te; ierr = VecRestoreArray(user->wind_data,&wd);CHKERRQ(ierr); ierr = VecRestoreArrayRead(U,&u);CHKERRQ(ierr); ierr = VecRestoreArrayRead(Udot,&udot);CHKERRQ(ierr); ierr = VecRestoreArray(F,&f);CHKERRQ(ierr); PetscFunctionReturn(0); }
/* * This is a modified version of PETSc/src/ts/examples/tutorials/ex15.c * to demonstrate how MOOSE interact with an external solver package */ PetscErrorCode externalPETScDiffusionFDMSolve(TS ts, Vec u, PetscReal dt, PetscReal time) { PetscErrorCode ierr; #if !PETSC_VERSION_LESS_THAN(3, 8, 0) PetscInt current_step; #endif DM da; PetscFunctionBeginUser; ierr = TSGetDM(ts, &da); CHKERRQ(ierr); #if !PETSC_VERSION_LESS_THAN(3, 7, 0) PetscOptionsSetValue(NULL, "-ts_monitor", NULL); PetscOptionsSetValue(NULL, "-snes_monitor", NULL); PetscOptionsSetValue(NULL, "-ksp_monitor", NULL); #else PetscOptionsSetValue("-ts_monitor", NULL); PetscOptionsSetValue("-snes_monitor", NULL); PetscOptionsSetValue("-ksp_monitor", NULL); #endif /*ierr = TSSetMaxTime(ts,1.0);CHKERRQ(ierr);*/ ierr = TSSetExactFinalTime(ts, TS_EXACTFINALTIME_STEPOVER); CHKERRQ(ierr); ierr = TSSetSolution(ts, u); CHKERRQ(ierr); ierr = TSSetTimeStep(ts, dt); CHKERRQ(ierr); ierr = TSSetTime(ts, time - dt); CHKERRQ(ierr); #if !PETSC_VERSION_LESS_THAN(3, 8, 0) ierr = TSGetStepNumber(ts, ¤t_step); CHKERRQ(ierr); ierr = TSSetMaxSteps(ts, current_step + 1); CHKERRQ(ierr); #else SETERRQ(PetscObjectComm((PetscObject)ts), PETSC_ERR_SUP, "Require PETSc-3.8.x or higher "); #endif /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Sets various TS parameters from user options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetFromOptions(ts); CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Solve nonlinear system - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSolve(ts, u); CHKERRQ(ierr); PetscFunctionReturn(0); }
/* Helper rutine to handle user postenvents and recording */ static PetscErrorCode TSPostEvent(TS ts,PetscReal t,Vec U) { PetscErrorCode ierr; TSEvent event = ts->event; PetscBool terminate = PETSC_FALSE; PetscBool restart = PETSC_FALSE; PetscInt i,ctr,stepnum; PetscBool inflag[2],outflag[2]; PetscBool forwardsolve = PETSC_TRUE; /* Flag indicating that TS is doing a forward solve */ PetscFunctionBegin; if (event->postevent) { PetscObjectState state_prev,state_post; ierr = PetscObjectStateGet((PetscObject)U,&state_prev);CHKERRQ(ierr); ierr = (*event->postevent)(ts,event->nevents_zero,event->events_zero,t,U,forwardsolve,event->ctx);CHKERRQ(ierr); ierr = PetscObjectStateGet((PetscObject)U,&state_post);CHKERRQ(ierr); if (state_prev != state_post) restart = PETSC_TRUE; } /* Handle termination events and step restart */ for (i=0; i<event->nevents_zero; i++) if (event->terminate[event->events_zero[i]]) terminate = PETSC_TRUE; inflag[0] = restart; inflag[1] = terminate; ierr = MPIU_Allreduce(inflag,outflag,2,MPIU_BOOL,MPI_LOR,((PetscObject)ts)->comm);CHKERRQ(ierr); restart = outflag[0]; terminate = outflag[1]; if (restart) {ierr = TSRestartStep(ts);CHKERRQ(ierr);} if (terminate) {ierr = TSSetConvergedReason(ts,TS_CONVERGED_EVENT);CHKERRQ(ierr);} event->status = terminate ? TSEVENT_NONE : TSEVENT_RESET_NEXTSTEP; /* Reset event residual functions as states might get changed by the postevent callback */ if (event->postevent) { ierr = VecLockPush(U);CHKERRQ(ierr); ierr = (*event->eventhandler)(ts,t,U,event->fvalue,event->ctx);CHKERRQ(ierr); ierr = VecLockPop(U);CHKERRQ(ierr); } /* Cache current time and event residual functions */ event->ptime_prev = t; for (i=0; i<event->nevents; i++) event->fvalue_prev[i] = event->fvalue[i]; /* Record the event in the event recorder */ ierr = TSGetStepNumber(ts,&stepnum);CHKERRQ(ierr); ctr = event->recorder.ctr; if (ctr == event->recsize) { ierr = TSEventRecorderResize(event);CHKERRQ(ierr); } event->recorder.time[ctr] = t; event->recorder.stepnum[ctr] = stepnum; event->recorder.nevents[ctr] = event->nevents_zero; for (i=0; i<event->nevents_zero; i++) event->recorder.eventidx[ctr][i] = event->events_zero[i]; event->recorder.ctr++; PetscFunctionReturn(0); }
int main(int argc,char **argv) { TS ts; /* nonlinear solver */ Vec x; /* solution, residual vectors */ Mat A; /* Jacobian matrix */ PetscInt steps; PetscReal ftime = 0.5; PetscBool monitor = PETSC_FALSE; PetscScalar *x_ptr; PetscMPIInt size; struct _n_User user; PetscErrorCode ierr; /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Initialize program - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = PetscInitialize(&argc,&argv,NULL,help);if (ierr) return ierr; ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); if (size != 1) SETERRQ(PETSC_COMM_SELF,1,"This is a uniprocessor example only!"); ierr = RegisterMyARK2();CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set runtime options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ user.next_output = 0.0; ierr = PetscOptionsGetBool(NULL,NULL,"-monitor",&monitor,NULL);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create necessary matrix and vectors, solve same ODE on every process - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr); ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,2,2);CHKERRQ(ierr); ierr = MatSetFromOptions(A);CHKERRQ(ierr); ierr = MatSetUp(A);CHKERRQ(ierr); ierr = MatCreateVecs(A,&x,NULL);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create timestepping solver context - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr); ierr = TSSetType(ts,TSBEULER);CHKERRQ(ierr); ierr = TSSetIFunction(ts,NULL,IFunction,&user);CHKERRQ(ierr); ierr = TSSetIJacobian(ts,A,A,IJacobian,&user);CHKERRQ(ierr); ierr = TSSetMaxTime(ts,ftime);CHKERRQ(ierr); ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr); if (monitor) { ierr = TSMonitorSet(ts,Monitor,&user,NULL);CHKERRQ(ierr); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set initial conditions - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = VecGetArray(x,&x_ptr);CHKERRQ(ierr); x_ptr[0] = -2; x_ptr[1] = -2.355301397608119909925287735864250951918; ierr = VecRestoreArray(x,&x_ptr);CHKERRQ(ierr); ierr = TSSetTimeStep(ts,.001);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set runtime options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetFromOptions(ts);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Solve nonlinear system - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSolve(ts,x);CHKERRQ(ierr); ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr); ierr = TSGetStepNumber(ts,&steps);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"steps %3D, ftime %g\n",steps,(double)ftime);CHKERRQ(ierr); ierr = VecView(x,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Free work space. All PETSc objects should be destroyed when they are no longer needed. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = TSDestroy(&ts);CHKERRQ(ierr); ierr = PetscFinalize(); return ierr; }
int main(int argc,char **argv) { TS ts; /* time integrator */ Vec x,r; /* solution, residual vectors */ PetscInt steps,Mx; PetscErrorCode ierr; DM da; PetscReal dt; UserCtx ctx; PetscBool mymonitor; PetscViewer viewer; PetscBool flg; /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Initialize program - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr; ctx.kappa = 1.0; ierr = PetscOptionsGetReal(NULL,NULL,"-kappa",&ctx.kappa,NULL);CHKERRQ(ierr); ctx.allencahn = PETSC_FALSE; ierr = PetscOptionsHasName(NULL,NULL,"-allen-cahn",&ctx.allencahn);CHKERRQ(ierr); ierr = PetscOptionsHasName(NULL,NULL,"-mymonitor",&mymonitor);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create distributed array (DMDA) to manage parallel grid and vectors - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = DMDACreate1d(PETSC_COMM_WORLD, DM_BOUNDARY_PERIODIC, 10,1,2,NULL,&da);CHKERRQ(ierr); ierr = DMSetFromOptions(da);CHKERRQ(ierr); ierr = DMSetUp(da);CHKERRQ(ierr); ierr = DMDASetFieldName(da,0,"Heat equation: u");CHKERRQ(ierr); ierr = DMDAGetInfo(da,0,&Mx,0,0,0,0,0,0,0,0,0,0,0);CHKERRQ(ierr); dt = 1.0/(ctx.kappa*Mx*Mx); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Extract global vectors from DMDA; then duplicate for remaining vectors that are the same types - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = DMCreateGlobalVector(da,&x);CHKERRQ(ierr); ierr = VecDuplicate(x,&r);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create timestepping solver context - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr); ierr = TSSetDM(ts,da);CHKERRQ(ierr); ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr); ierr = TSSetRHSFunction(ts,NULL,FormFunction,&ctx);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Customize nonlinear solver - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetType(ts,TSCN);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set initial conditions - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = FormInitialSolution(da,x);CHKERRQ(ierr); ierr = TSSetTimeStep(ts,dt);CHKERRQ(ierr); ierr = TSSetMaxTime(ts,.02);CHKERRQ(ierr); ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_INTERPOLATE);CHKERRQ(ierr); ierr = TSSetSolution(ts,x);CHKERRQ(ierr); if (mymonitor) { ctx.ports = NULL; ierr = TSMonitorSet(ts,MyMonitor,&ctx,MyDestroy);CHKERRQ(ierr); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set runtime options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetFromOptions(ts);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Solve nonlinear system - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSolve(ts,x);CHKERRQ(ierr); ierr = TSGetStepNumber(ts,&steps);CHKERRQ(ierr); ierr = PetscOptionsHasName(NULL,NULL,"-square_initial",&flg);CHKERRQ(ierr); if (flg) { ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"InitialSolution.heat",FILE_MODE_WRITE,&viewer);CHKERRQ(ierr); ierr = VecView(x,viewer);CHKERRQ(ierr); ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Free work space. All PETSc objects should be destroyed when they are no longer needed. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = VecDestroy(&r);CHKERRQ(ierr); ierr = TSDestroy(&ts);CHKERRQ(ierr); ierr = DMDestroy(&da);CHKERRQ(ierr); ierr = PetscFinalize(); return ierr; }
/* * time_step solves for the time_dependence of the system * that was previously setup using the add_to_ham and add_lin * routines. Solver selection and parameters can be controlled via PETSc * command line options. Default solver is TSRK3BS * * Inputs: * Vec x: The density matrix, with appropriate inital conditions * double dt: initial timestep. For certain explicit methods, this timestep * can be changed, as those methods have adaptive time steps * double time_max: the maximum time to integrate to * int steps_max: max number of steps to take */ void time_step(Vec x, PetscReal init_time, PetscReal time_max,PetscReal dt,PetscInt steps_max){ PetscViewer mat_view; TS ts; /* timestepping context */ PetscInt i,j,Istart,Iend,steps,row,col; PetscScalar mat_tmp; PetscReal tmp_real; Mat AA; PetscInt nevents,direction; PetscBool terminate; operator op; int num_pop; double *populations; Mat solve_A,solve_stiff_A; PetscLogStagePop(); PetscLogStagePush(solve_stage); if (_lindblad_terms) { if (nid==0) { printf("Lindblad terms found, using Lindblad solver.\n"); } solve_A = full_A; if (_stiff_solver) { if(nid==0) printf("ERROR! Lindblad-stiff solver untested."); exit(0); } } else { if (nid==0) { printf("No Lindblad terms found, using (more efficient) Schrodinger solver.\n"); } solve_A = ham_A; solve_stiff_A = ham_stiff_A; if (_num_time_dep&&_stiff_solver) { if(nid==0) printf("ERROR! Schrodinger-stiff + timedep solver untested."); exit(0); } } /* Possibly print dense ham. No stabilization is needed? */ if (nid==0) { /* Print dense ham, if it was asked for */ if (_print_dense_ham){ FILE *fp_ham; fp_ham = fopen("ham","w"); if (nid==0){ for (i=0;i<total_levels;i++){ for (j=0;j<total_levels;j++){ fprintf(fp_ham,"%e %e ",PetscRealPart(_hamiltonian[i][j]),PetscImaginaryPart(_hamiltonian[i][j])); } fprintf(fp_ham,"\n"); } } fclose(fp_ham); for (i=0;i<total_levels;i++){ free(_hamiltonian[i]); } free(_hamiltonian); _print_dense_ham = 0; } } /* Remove stabilization if it was previously added */ if (stab_added){ if (nid==0) printf("Removing stabilization...\n"); /* * We add 1.0 in the 0th spot and every n+1 after */ if (nid==0) { row = 0; for (i=0;i<total_levels;i++){ col = i*(total_levels+1); mat_tmp = -1.0 + 0.*PETSC_i; MatSetValue(full_A,row,col,mat_tmp,ADD_VALUES); } } } MatGetOwnershipRange(solve_A,&Istart,&Iend); /* * Explicitly add 0.0 to all diagonal elements; * this fixes a 'matrix in wrong state' message that PETSc * gives if the diagonal was never initialized. */ //if (nid==0) printf("Adding 0 to diagonal elements...\n"); for (i=Istart;i<Iend;i++){ mat_tmp = 0 + 0.*PETSC_i; MatSetValue(solve_A,i,i,mat_tmp,ADD_VALUES); } if(_stiff_solver){ MatGetOwnershipRange(solve_stiff_A,&Istart,&Iend); for (i=Istart;i<Iend;i++){ mat_tmp = 0 + 0.*PETSC_i; MatSetValue(solve_stiff_A,i,i,mat_tmp,ADD_VALUES); } } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -* * Create the timestepping solver and set various options * *- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* * Create timestepping solver context */ TSCreate(PETSC_COMM_WORLD,&ts); TSSetProblemType(ts,TS_LINEAR); /* * Set function to get information at every timestep */ if (_ts_monitor!=NULL){ TSMonitorSet(ts,_ts_monitor,_tsctx,NULL); } /* * Set up ODE system */ TSSetRHSFunction(ts,NULL,TSComputeRHSFunctionLinear,NULL); if(_stiff_solver) { /* TSSetIFunction(ts,NULL,TSComputeRHSFunctionLinear,NULL); */ if (nid==0) { printf("Stiff solver not implemented!\n"); exit(0); } if(nid==0) printf("Using stiff solver - TSROSW\n"); } if(_num_time_dep+_num_time_dep_lin) { for(i=0;i<_num_time_dep;i++){ tmp_real = 0.0; _add_ops_to_mat_ham(tmp_real,solve_A,_time_dep_list[i].num_ops,_time_dep_list[i].ops); } for(i=0;i<_num_time_dep_lin;i++){ tmp_real = 0.0; _add_ops_to_mat_lin(tmp_real,solve_A,_time_dep_list_lin[i].num_ops,_time_dep_list_lin[i].ops); } /* Tell PETSc to assemble the matrix */ MatAssemblyBegin(solve_A,MAT_FINAL_ASSEMBLY); MatAssemblyEnd(solve_A,MAT_FINAL_ASSEMBLY); if (nid==0) printf("Matrix Assembled.\n"); MatDuplicate(solve_A,MAT_COPY_VALUES,&AA); MatAssemblyBegin(AA,MAT_FINAL_ASSEMBLY); MatAssemblyEnd(AA,MAT_FINAL_ASSEMBLY); TSSetRHSJacobian(ts,AA,AA,_RHS_time_dep_ham_p,NULL); } else { /* Tell PETSc to assemble the matrix */ MatAssemblyBegin(solve_A,MAT_FINAL_ASSEMBLY); MatAssemblyEnd(solve_A,MAT_FINAL_ASSEMBLY); if (_stiff_solver){ MatAssemblyBegin(solve_stiff_A,MAT_FINAL_ASSEMBLY); MatAssemblyEnd(solve_stiff_A,MAT_FINAL_ASSEMBLY); /* TSSetIJacobian(ts,solve_stiff_A,solve_stiff_A,TSComputeRHSJacobianConstant,NULL); */ if (nid==0) { printf("Stiff solver not implemented!\n"); exit(0); } } if (nid==0) printf("Matrix Assembled.\n"); TSSetRHSJacobian(ts,solve_A,solve_A,TSComputeRHSJacobianConstant,NULL); } /* Print information about the matrix. */ PetscViewerASCIIOpen(PETSC_COMM_WORLD,NULL,&mat_view); PetscViewerPushFormat(mat_view,PETSC_VIEWER_ASCII_INFO); /* PetscViewerPushFormat(mat_view,PETSC_VIEWER_ASCII_MATLAB); */ /* MatView(solve_A,mat_view); */ /* PetscInt ncols; */ /* const PetscInt *cols; */ /* const PetscScalar *vals; */ /* for(i=0;i<total_levels*total_levels;i++){ */ /* MatGetRow(solve_A,i,&ncols,&cols,&vals); */ /* for (j=0;j<ncols;j++){ */ /* if(PetscAbsComplex(vals[j])>1e-5){ */ /* printf("%d %d %lf %lf\n",i,cols[j],vals[j]); */ /* } */ /* } */ /* MatRestoreRow(solve_A,i,&ncols,&cols,&vals); */ /* } */ if(_stiff_solver){ MatView(solve_stiff_A,mat_view); } PetscViewerPopFormat(mat_view); PetscViewerDestroy(&mat_view); TSSetTimeStep(ts,dt); /* * Set default options, can be changed at runtime */ TSSetMaxSteps(ts,steps_max); TSSetMaxTime(ts,time_max); TSSetTime(ts,init_time); TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER); if (_stiff_solver) { TSSetType(ts,TSROSW); } else { TSSetType(ts,TSRK); TSRKSetType(ts,TSRK3BS); } /* If we have gates to apply, set up the event handler. */ if (_num_quantum_gates > 0) { nevents = 1; //Only one event for now (did we cross a gate?) direction = -1; //We only want to count an event if we go from positive to negative terminate = PETSC_FALSE; //Keep time stepping after we passed our event /* Arguments are: ts context, nevents, direction of zero crossing, whether to terminate, * a function to check event status, a function to apply events, private data context. */ TSSetEventHandler(ts,nevents,&direction,&terminate,_QG_EventFunction,_QG_PostEventFunction,NULL); } if (_num_circuits > 0) { nevents = 1; //Only one event for now (did we cross a gate?) direction = -1; //We only want to count an event if we go from positive to negative terminate = PETSC_FALSE; //Keep time stepping after we passed our event /* Arguments are: ts context, nevents, direction of zero crossing, whether to terminate, * a function to check event status, a function to apply events, private data context. */ TSSetEventHandler(ts,nevents,&direction,&terminate,_QC_EventFunction,_QC_PostEventFunction,NULL); } if (_discrete_ec > 0) { nevents = 1; //Only one event for now (did we cross an ec step?) direction = -1; //We only want to count an event if we go from positive to negative terminate = PETSC_FALSE; //Keep time stepping after we passed our event /* Arguments are: ts context, nevents, direction of zero crossing, whether to terminate, * a function to check event status, a function to apply events, private data context. */ TSSetEventHandler(ts,nevents,&direction,&terminate,_DQEC_EventFunction,_DQEC_PostEventFunction,NULL); } /* if (_lindblad_terms) { */ /* nevents = 1; //Only one event for now (did we cross a gate?) */ /* direction = 0; //We only want to count an event if we go from positive to negative */ /* terminate = PETSC_FALSE; //Keep time stepping after we passed our event */ /* TSSetEventHandler(ts,nevents,&direction,&terminate,_Normalize_EventFunction,_Normalize_PostEventFunction,NULL); */ /* } */ TSSetFromOptions(ts); TSSolve(ts,x); TSGetStepNumber(ts,&steps); num_pop = get_num_populations(); populations = malloc(num_pop*sizeof(double)); get_populations(x,&populations); /* if(nid==0){ */ /* printf("Final populations: "); */ /* for(i=0;i<num_pop;i++){ */ /* printf(" %e ",populations[i]); */ /* } */ /* printf("\n"); */ /* } */ /* PetscPrintf(PETSC_COMM_WORLD,"Steps %D\n",steps); */ /* Free work space */ TSDestroy(&ts); if(_num_time_dep+_num_time_dep_lin){ MatDestroy(&AA); } free(populations); PetscLogStagePop(); PetscLogStagePush(post_solve_stage); return; }
int main(int argc,char **argv) { TS ts; /* nonlinear solver */ PetscBool monitor = PETSC_FALSE; PetscScalar *x_ptr,*y_ptr; PetscMPIInt size; struct _n_User user; PetscErrorCode ierr; /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Initialize program - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = PetscInitialize(&argc,&argv,NULL,help);if (ierr) return ierr; ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); if (size != 1) SETERRQ(PETSC_COMM_SELF,1,"This is a uniprocessor example only!"); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set runtime options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ user.next_output = 0.0; user.mu = 1.0e6; user.steps = 0; user.ftime = 0.5; ierr = PetscOptionsGetBool(NULL,NULL,"-monitor",&monitor,NULL);CHKERRQ(ierr); ierr = PetscOptionsGetReal(NULL,NULL,"-mu",&user.mu,NULL);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create necessary matrix and vectors, solve same ODE on every process - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = MatCreate(PETSC_COMM_WORLD,&user.A);CHKERRQ(ierr); ierr = MatSetSizes(user.A,PETSC_DECIDE,PETSC_DECIDE,2,2);CHKERRQ(ierr); ierr = MatSetFromOptions(user.A);CHKERRQ(ierr); ierr = MatSetUp(user.A);CHKERRQ(ierr); ierr = MatCreateVecs(user.A,&user.x,NULL);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_WORLD,&user.Jacp);CHKERRQ(ierr); ierr = MatSetSizes(user.Jacp,PETSC_DECIDE,PETSC_DECIDE,2,1);CHKERRQ(ierr); ierr = MatSetFromOptions(user.Jacp);CHKERRQ(ierr); ierr = MatSetUp(user.Jacp);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create timestepping solver context - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr); ierr = TSSetType(ts,TSCN);CHKERRQ(ierr); ierr = TSSetIFunction(ts,NULL,IFunction,&user);CHKERRQ(ierr); ierr = TSSetIJacobian(ts,user.A,user.A,IJacobian,&user);CHKERRQ(ierr); ierr = TSSetMaxTime(ts,user.ftime);CHKERRQ(ierr); ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr); if (monitor) { ierr = TSMonitorSet(ts,Monitor,&user,NULL);CHKERRQ(ierr); } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set initial conditions - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = VecGetArray(user.x,&x_ptr);CHKERRQ(ierr); x_ptr[0] = 2.0; x_ptr[1] = -0.66666654321; ierr = VecRestoreArray(user.x,&x_ptr);CHKERRQ(ierr); ierr = TSSetTimeStep(ts,.0001);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Save trajectory of solution so that TSAdjointSolve() may be used - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set runtime options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetFromOptions(ts);CHKERRQ(ierr); ierr = TSSolve(ts,user.x);CHKERRQ(ierr); ierr = TSGetSolveTime(ts,&user.ftime);CHKERRQ(ierr); ierr = TSGetStepNumber(ts,&user.steps);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Adjoint model starts here - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = MatCreateVecs(user.A,&user.lambda[0],NULL);CHKERRQ(ierr); /* Set initial conditions for the adjoint integration */ ierr = VecGetArray(user.lambda[0],&y_ptr);CHKERRQ(ierr); y_ptr[0] = 1.0; y_ptr[1] = 0.0; ierr = VecRestoreArray(user.lambda[0],&y_ptr);CHKERRQ(ierr); ierr = MatCreateVecs(user.A,&user.lambda[1],NULL);CHKERRQ(ierr); ierr = VecGetArray(user.lambda[1],&y_ptr);CHKERRQ(ierr); y_ptr[0] = 0.0; y_ptr[1] = 1.0; ierr = VecRestoreArray(user.lambda[1],&y_ptr);CHKERRQ(ierr); ierr = MatCreateVecs(user.Jacp,&user.mup[0],NULL);CHKERRQ(ierr); ierr = VecGetArray(user.mup[0],&x_ptr);CHKERRQ(ierr); x_ptr[0] = 0.0; ierr = VecRestoreArray(user.mup[0],&x_ptr);CHKERRQ(ierr); ierr = MatCreateVecs(user.Jacp,&user.mup[1],NULL);CHKERRQ(ierr); ierr = VecGetArray(user.mup[1],&x_ptr);CHKERRQ(ierr); x_ptr[0] = 0.0; ierr = VecRestoreArray(user.mup[1],&x_ptr);CHKERRQ(ierr); ierr = TSSetCostGradients(ts,2,user.lambda,user.mup);CHKERRQ(ierr); /* Set RHS JacobianP */ ierr = TSSetRHSJacobianP(ts,user.Jacp,RHSJacobianP,&user);CHKERRQ(ierr); ierr = TSAdjointSolve(ts);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"\n sensitivity wrt initial conditions: d[y(tf)]/d[y0] d[y(tf)]/d[z0]\n");CHKERRQ(ierr); ierr = VecView(user.lambda[0],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"\n sensitivity wrt initial conditions: d[z(tf)]/d[y0] d[z(tf)]/d[z0]\n");CHKERRQ(ierr); ierr = VecView(user.lambda[1],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"\n sensitivity wrt parameters: d[y(tf)]/d[mu]\n");CHKERRQ(ierr); ierr = VecView(user.mup[0],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"\n sensivitity wrt parameters: d[z(tf)]/d[mu]\n");CHKERRQ(ierr); ierr = VecView(user.mup[1],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Free work space. All PETSc objects should be destroyed when they are no longer needed. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = MatDestroy(&user.A);CHKERRQ(ierr); ierr = MatDestroy(&user.Jacp);CHKERRQ(ierr); ierr = VecDestroy(&user.x);CHKERRQ(ierr); ierr = VecDestroy(&user.lambda[0]);CHKERRQ(ierr); ierr = VecDestroy(&user.lambda[1]);CHKERRQ(ierr); ierr = VecDestroy(&user.mup[0]);CHKERRQ(ierr); ierr = VecDestroy(&user.mup[1]);CHKERRQ(ierr); ierr = TSDestroy(&ts);CHKERRQ(ierr); ierr = PetscFinalize(); return(ierr); }
int main(int argc,char **argv) { TS ts,quadts; /* ODE integrator */ Vec U; /* solution will be stored here */ Mat A; /* Jacobian matrix */ Mat Jacp; /* Jacobian matrix */ Mat DRDU,DRDP; PetscErrorCode ierr; PetscMPIInt size; PetscInt n = 2; AppCtx ctx; PetscScalar *u; PetscReal du[2] = {0.0,0.0}; PetscBool ensemble = PETSC_FALSE,flg1,flg2; PetscReal ftime; PetscInt steps; PetscScalar *x_ptr,*y_ptr; Vec lambda[1],q,mu[1]; /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Initialize program - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr; ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); if (size > 1) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Only for sequential runs"); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create necessary matrix and vectors - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr); ierr = MatSetSizes(A,n,n,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr); ierr = MatSetType(A,MATDENSE);CHKERRQ(ierr); ierr = MatSetFromOptions(A);CHKERRQ(ierr); ierr = MatSetUp(A);CHKERRQ(ierr); ierr = MatCreateVecs(A,&U,NULL);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_WORLD,&Jacp);CHKERRQ(ierr); ierr = MatSetSizes(Jacp,PETSC_DECIDE,PETSC_DECIDE,2,1);CHKERRQ(ierr); ierr = MatSetFromOptions(Jacp);CHKERRQ(ierr); ierr = MatSetUp(Jacp);CHKERRQ(ierr); ierr = MatCreateDense(PETSC_COMM_WORLD,PETSC_DECIDE,PETSC_DECIDE,1,1,NULL,&DRDP);CHKERRQ(ierr); ierr = MatSetUp(DRDP);CHKERRQ(ierr); ierr = MatCreateDense(PETSC_COMM_WORLD,PETSC_DECIDE,PETSC_DECIDE,1,1,NULL,&DRDU);CHKERRQ(ierr); ierr = MatSetUp(DRDU);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set runtime options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"Swing equation options","");CHKERRQ(ierr); { ctx.beta = 2; ctx.c = 10000.0; ctx.u_s = 1.0; ctx.omega_s = 1.0; ctx.omega_b = 120.0*PETSC_PI; ctx.H = 5.0; ierr = PetscOptionsScalar("-Inertia","","",ctx.H,&ctx.H,NULL);CHKERRQ(ierr); ctx.D = 5.0; ierr = PetscOptionsScalar("-D","","",ctx.D,&ctx.D,NULL);CHKERRQ(ierr); ctx.E = 1.1378; ctx.V = 1.0; ctx.X = 0.545; ctx.Pmax = ctx.E*ctx.V/ctx.X;; ierr = PetscOptionsScalar("-Pmax","","",ctx.Pmax,&ctx.Pmax,NULL);CHKERRQ(ierr); ctx.Pm = 1.1; ierr = PetscOptionsScalar("-Pm","","",ctx.Pm,&ctx.Pm,NULL);CHKERRQ(ierr); ctx.tf = 0.1; ctx.tcl = 0.2; ierr = PetscOptionsReal("-tf","Time to start fault","",ctx.tf,&ctx.tf,NULL);CHKERRQ(ierr); ierr = PetscOptionsReal("-tcl","Time to end fault","",ctx.tcl,&ctx.tcl,NULL);CHKERRQ(ierr); ierr = PetscOptionsBool("-ensemble","Run ensemble of different initial conditions","",ensemble,&ensemble,NULL);CHKERRQ(ierr); if (ensemble) { ctx.tf = -1; ctx.tcl = -1; } ierr = VecGetArray(U,&u);CHKERRQ(ierr); u[0] = PetscAsinScalar(ctx.Pm/ctx.Pmax); u[1] = 1.0; ierr = PetscOptionsRealArray("-u","Initial solution","",u,&n,&flg1);CHKERRQ(ierr); n = 2; ierr = PetscOptionsRealArray("-du","Perturbation in initial solution","",du,&n,&flg2);CHKERRQ(ierr); u[0] += du[0]; u[1] += du[1]; ierr = VecRestoreArray(U,&u);CHKERRQ(ierr); if (flg1 || flg2) { ctx.tf = -1; ctx.tcl = -1; } } ierr = PetscOptionsEnd();CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create timestepping solver context - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr); ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr); ierr = TSSetType(ts,TSRK);CHKERRQ(ierr); ierr = TSSetRHSFunction(ts,NULL,(TSRHSFunction)RHSFunction,&ctx);CHKERRQ(ierr); ierr = TSSetRHSJacobian(ts,A,A,(TSRHSJacobian)RHSJacobian,&ctx);CHKERRQ(ierr); ierr = TSCreateQuadratureTS(ts,PETSC_TRUE,&quadts);CHKERRQ(ierr); ierr = TSSetRHSFunction(quadts,NULL,(TSRHSFunction)CostIntegrand,&ctx);CHKERRQ(ierr); ierr = TSSetRHSJacobian(quadts,DRDU,DRDU,(TSRHSJacobian)DRDUJacobianTranspose,&ctx);CHKERRQ(ierr); ierr = TSSetRHSJacobianP(quadts,DRDP,(TSRHSJacobianP)DRDPJacobianTranspose,&ctx);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set initial conditions - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetSolution(ts,U);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Save trajectory of solution so that TSAdjointSolve() may be used - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetSaveTrajectory(ts);CHKERRQ(ierr); ierr = MatCreateVecs(A,&lambda[0],NULL);CHKERRQ(ierr); /* Set initial conditions for the adjoint integration */ ierr = VecGetArray(lambda[0],&y_ptr);CHKERRQ(ierr); y_ptr[0] = 0.0; y_ptr[1] = 0.0; ierr = VecRestoreArray(lambda[0],&y_ptr);CHKERRQ(ierr); ierr = MatCreateVecs(Jacp,&mu[0],NULL);CHKERRQ(ierr); ierr = VecGetArray(mu[0],&x_ptr);CHKERRQ(ierr); x_ptr[0] = -1.0; ierr = VecRestoreArray(mu[0],&x_ptr);CHKERRQ(ierr); ierr = TSSetCostGradients(ts,1,lambda,mu);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set solver options - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = TSSetMaxTime(ts,10.0);CHKERRQ(ierr); ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP);CHKERRQ(ierr); ierr = TSSetTimeStep(ts,.01);CHKERRQ(ierr); ierr = TSSetFromOptions(ts);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Solve nonlinear system - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ if (ensemble) { for (du[1] = -2.5; du[1] <= .01; du[1] += .1) { ierr = VecGetArray(U,&u);CHKERRQ(ierr); u[0] = PetscAsinScalar(ctx.Pm/ctx.Pmax); u[1] = ctx.omega_s; u[0] += du[0]; u[1] += du[1]; ierr = VecRestoreArray(U,&u);CHKERRQ(ierr); ierr = TSSetTimeStep(ts,.01);CHKERRQ(ierr); ierr = TSSolve(ts,U);CHKERRQ(ierr); } } else { ierr = TSSolve(ts,U);CHKERRQ(ierr); } ierr = VecView(U,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr); ierr = TSGetStepNumber(ts,&steps);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Adjoint model starts here - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ /* Set initial conditions for the adjoint integration */ ierr = VecGetArray(lambda[0],&y_ptr);CHKERRQ(ierr); y_ptr[0] = 0.0; y_ptr[1] = 0.0; ierr = VecRestoreArray(lambda[0],&y_ptr);CHKERRQ(ierr); ierr = VecGetArray(mu[0],&x_ptr);CHKERRQ(ierr); x_ptr[0] = -1.0; ierr = VecRestoreArray(mu[0],&x_ptr);CHKERRQ(ierr); /* Set RHS JacobianP */ ierr = TSSetRHSJacobianP(ts,Jacp,RHSJacobianP,&ctx);CHKERRQ(ierr); ierr = TSAdjointSolve(ts);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"\n sensitivity wrt initial conditions: d[Psi(tf)]/d[phi0] d[Psi(tf)]/d[omega0]\n");CHKERRQ(ierr); ierr = VecView(lambda[0],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = VecView(mu[0],PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = TSGetCostIntegral(ts,&q);CHKERRQ(ierr); ierr = VecView(q,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr); ierr = VecGetArray(q,&x_ptr);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"\n cost function=%g\n",(double)(x_ptr[0]-ctx.Pm));CHKERRQ(ierr); ierr = VecRestoreArray(q,&x_ptr);CHKERRQ(ierr); ierr = ComputeSensiP(lambda[0],mu[0],&ctx);CHKERRQ(ierr); /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Free work space. All PETSc objects should be destroyed when they are no longer needed. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ierr = MatDestroy(&A);CHKERRQ(ierr); ierr = MatDestroy(&Jacp);CHKERRQ(ierr); ierr = MatDestroy(&DRDU);CHKERRQ(ierr); ierr = MatDestroy(&DRDP);CHKERRQ(ierr); ierr = VecDestroy(&U);CHKERRQ(ierr); ierr = VecDestroy(&lambda[0]);CHKERRQ(ierr); ierr = VecDestroy(&mu[0]);CHKERRQ(ierr); ierr = TSDestroy(&ts);CHKERRQ(ierr); ierr = PetscFinalize(); return ierr; }