xref: /petsc/src/ts/tests/ex3.c (revision 5f80ce2ab25dff0f4601e710601cbbcecf323266)
1c4762a1bSJed Brown 
2c4762a1bSJed Brown static char help[] = "Solves 1D heat equation with FEM formulation.\n\
3c4762a1bSJed Brown Input arguments are\n\
4c4762a1bSJed Brown   -useAlhs: solve Alhs*U' =  (Arhs*U + g) \n\
5c4762a1bSJed Brown             otherwise, solve U' = inv(Alhs)*(Arhs*U + g) \n\n";
6c4762a1bSJed Brown 
7c4762a1bSJed Brown /*--------------------------------------------------------------------------
8c4762a1bSJed Brown   Solves 1D heat equation U_t = U_xx with FEM formulation:
9c4762a1bSJed Brown                           Alhs*U' = rhs (= Arhs*U + g)
10c4762a1bSJed Brown   We thank Chris Cox <clcox@clemson.edu> for contributing the original code
11c4762a1bSJed Brown ----------------------------------------------------------------------------*/
12c4762a1bSJed Brown 
13c4762a1bSJed Brown #include <petscksp.h>
14c4762a1bSJed Brown #include <petscts.h>
15c4762a1bSJed Brown 
16c4762a1bSJed Brown /* special variable - max size of all arrays  */
17c4762a1bSJed Brown #define num_z 10
18c4762a1bSJed Brown 
19c4762a1bSJed Brown /*
20c4762a1bSJed Brown    User-defined application context - contains data needed by the
21c4762a1bSJed Brown    application-provided call-back routines.
22c4762a1bSJed Brown */
23c4762a1bSJed Brown typedef struct {
24c4762a1bSJed Brown   Mat         Amat;               /* left hand side matrix */
25c4762a1bSJed Brown   Vec         ksp_rhs,ksp_sol;    /* working vectors for formulating inv(Alhs)*(Arhs*U+g) */
26c4762a1bSJed Brown   int         max_probsz;         /* max size of the problem */
27c4762a1bSJed Brown   PetscBool   useAlhs;            /* flag (1 indicates solving Alhs*U' = Arhs*U+g */
28c4762a1bSJed Brown   int         nz;                 /* total number of grid points */
29c4762a1bSJed Brown   PetscInt    m;                  /* total number of interio grid points */
30c4762a1bSJed Brown   Vec         solution;           /* global exact ts solution vector */
31c4762a1bSJed Brown   PetscScalar *z;                 /* array of grid points */
32c4762a1bSJed Brown   PetscBool   debug;              /* flag (1 indicates activation of debugging printouts) */
33c4762a1bSJed Brown } AppCtx;
34c4762a1bSJed Brown 
35c4762a1bSJed Brown extern PetscScalar exact(PetscScalar,PetscReal);
36c4762a1bSJed Brown extern PetscErrorCode Monitor(TS,PetscInt,PetscReal,Vec,void*);
37c4762a1bSJed Brown extern PetscErrorCode Petsc_KSPSolve(AppCtx*);
38c4762a1bSJed Brown extern PetscScalar bspl(PetscScalar*,PetscScalar,PetscInt,PetscInt,PetscInt[][2],PetscInt);
39c4762a1bSJed Brown extern PetscErrorCode femBg(PetscScalar[][3],PetscScalar*,PetscInt,PetscScalar*,PetscReal);
40c4762a1bSJed Brown extern PetscErrorCode femA(AppCtx*,PetscInt,PetscScalar*);
41c4762a1bSJed Brown extern PetscErrorCode rhs(AppCtx*,PetscScalar*, PetscInt, PetscScalar*,PetscReal);
42c4762a1bSJed Brown extern PetscErrorCode RHSfunction(TS,PetscReal,Vec,Vec,void*);
43c4762a1bSJed Brown 
44c4762a1bSJed Brown int main(int argc,char **argv)
45c4762a1bSJed Brown {
46c4762a1bSJed Brown   PetscInt       i,m,nz,steps,max_steps,k,nphase=1;
47c4762a1bSJed Brown   PetscScalar    zInitial,zFinal,val,*z;
48c4762a1bSJed Brown   PetscReal      stepsz[4],T,ftime;
49c4762a1bSJed Brown   PetscErrorCode ierr;
50c4762a1bSJed Brown   TS             ts;
51c4762a1bSJed Brown   SNES           snes;
52c4762a1bSJed Brown   Mat            Jmat;
53c4762a1bSJed Brown   AppCtx         appctx;   /* user-defined application context */
54c4762a1bSJed Brown   Vec            init_sol; /* ts solution vector */
55c4762a1bSJed Brown   PetscMPIInt    size;
56c4762a1bSJed Brown 
57c4762a1bSJed Brown   ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
58*5f80ce2aSJacob Faibussowitsch   CHKERRMPI(MPI_Comm_size(PETSC_COMM_WORLD,&size));
593c633725SBarry Smith   PetscCheck(size == 1,PETSC_COMM_SELF,PETSC_ERR_WRONG_MPI_SIZE,"This is a uniprocessor example only");
60c4762a1bSJed Brown 
61c4762a1bSJed Brown   /* initializations */
62c4762a1bSJed Brown   zInitial  = 0.0;
63c4762a1bSJed Brown   zFinal    = 1.0;
64c4762a1bSJed Brown   nz        = num_z;
65c4762a1bSJed Brown   m         = nz-2;
66c4762a1bSJed Brown   appctx.nz = nz;
67c4762a1bSJed Brown   max_steps = (PetscInt)10000;
68c4762a1bSJed Brown 
69c4762a1bSJed Brown   appctx.m          = m;
70c4762a1bSJed Brown   appctx.max_probsz = nz;
71c4762a1bSJed Brown   appctx.debug      = PETSC_FALSE;
72c4762a1bSJed Brown   appctx.useAlhs    = PETSC_FALSE;
73c4762a1bSJed Brown 
74303a5415SBarry Smith   ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"","");CHKERRQ(ierr);
75*5f80ce2aSJacob Faibussowitsch   CHKERRQ(PetscOptionsName("-debug",NULL,NULL,&appctx.debug));
76*5f80ce2aSJacob Faibussowitsch   CHKERRQ(PetscOptionsName("-useAlhs",NULL,NULL,&appctx.useAlhs));
77*5f80ce2aSJacob Faibussowitsch   CHKERRQ(PetscOptionsRangeInt("-nphase",NULL,NULL,nphase,&nphase,NULL,1,3));
78*5f80ce2aSJacob Faibussowitsch   ierr = PetscOptionsEnd();CHKERRQ(ierr);
79303a5415SBarry Smith   T = 0.014/nphase;
80303a5415SBarry Smith 
81c4762a1bSJed Brown   /* create vector to hold ts solution */
82c4762a1bSJed Brown   /*-----------------------------------*/
83*5f80ce2aSJacob Faibussowitsch   CHKERRQ(VecCreate(PETSC_COMM_WORLD, &init_sol));
84*5f80ce2aSJacob Faibussowitsch   CHKERRQ(VecSetSizes(init_sol, PETSC_DECIDE, m));
85*5f80ce2aSJacob Faibussowitsch   CHKERRQ(VecSetFromOptions(init_sol));
86c4762a1bSJed Brown 
87c4762a1bSJed Brown   /* create vector to hold true ts soln for comparison */
88*5f80ce2aSJacob Faibussowitsch   CHKERRQ(VecDuplicate(init_sol, &appctx.solution));
89c4762a1bSJed Brown 
90c4762a1bSJed Brown   /* create LHS matrix Amat */
91c4762a1bSJed Brown   /*------------------------*/
92*5f80ce2aSJacob Faibussowitsch   CHKERRQ(MatCreateSeqAIJ(PETSC_COMM_WORLD, m, m, 3, NULL, &appctx.Amat));
93*5f80ce2aSJacob Faibussowitsch   CHKERRQ(MatSetFromOptions(appctx.Amat));
94*5f80ce2aSJacob Faibussowitsch   CHKERRQ(MatSetUp(appctx.Amat));
95c4762a1bSJed Brown   /* set space grid points - interio points only! */
96*5f80ce2aSJacob Faibussowitsch   CHKERRQ(PetscMalloc1(nz+1,&z));
97c4762a1bSJed Brown   for (i=0; i<nz; i++) z[i]=(i)*((zFinal-zInitial)/(nz-1));
98c4762a1bSJed Brown   appctx.z = z;
99c4762a1bSJed Brown   femA(&appctx,nz,z);
100c4762a1bSJed Brown 
101c4762a1bSJed Brown   /* create the jacobian matrix */
102c4762a1bSJed Brown   /*----------------------------*/
103*5f80ce2aSJacob Faibussowitsch   CHKERRQ(MatCreate(PETSC_COMM_WORLD, &Jmat));
104*5f80ce2aSJacob Faibussowitsch   CHKERRQ(MatSetSizes(Jmat,PETSC_DECIDE,PETSC_DECIDE,m,m));
105*5f80ce2aSJacob Faibussowitsch   CHKERRQ(MatSetFromOptions(Jmat));
106*5f80ce2aSJacob Faibussowitsch   CHKERRQ(MatSetUp(Jmat));
107c4762a1bSJed Brown 
108c4762a1bSJed Brown   /* create working vectors for formulating rhs=inv(Alhs)*(Arhs*U + g) */
109*5f80ce2aSJacob Faibussowitsch   CHKERRQ(VecDuplicate(init_sol,&appctx.ksp_rhs));
110*5f80ce2aSJacob Faibussowitsch   CHKERRQ(VecDuplicate(init_sol,&appctx.ksp_sol));
111c4762a1bSJed Brown 
1122d4ee042Sprj-   /* set initial guess */
1132d4ee042Sprj-   /*-------------------*/
114c4762a1bSJed Brown   for (i=0; i<nz-2; i++) {
115c4762a1bSJed Brown     val  = exact(z[i+1], 0.0);
116*5f80ce2aSJacob Faibussowitsch     CHKERRQ(VecSetValue(init_sol,i,(PetscScalar)val,INSERT_VALUES));
117c4762a1bSJed Brown   }
118*5f80ce2aSJacob Faibussowitsch   CHKERRQ(VecAssemblyBegin(init_sol));
119*5f80ce2aSJacob Faibussowitsch   CHKERRQ(VecAssemblyEnd(init_sol));
120c4762a1bSJed Brown 
121c4762a1bSJed Brown   /*create a time-stepping context and set the problem type */
122c4762a1bSJed Brown   /*--------------------------------------------------------*/
123*5f80ce2aSJacob Faibussowitsch   CHKERRQ(TSCreate(PETSC_COMM_WORLD, &ts));
124*5f80ce2aSJacob Faibussowitsch   CHKERRQ(TSSetProblemType(ts,TS_NONLINEAR));
125c4762a1bSJed Brown 
126c4762a1bSJed Brown   /* set time-step method */
127*5f80ce2aSJacob Faibussowitsch   CHKERRQ(TSSetType(ts,TSCN));
128c4762a1bSJed Brown 
129c4762a1bSJed Brown   /* Set optional user-defined monitoring routine */
130*5f80ce2aSJacob Faibussowitsch   CHKERRQ(TSMonitorSet(ts,Monitor,&appctx,NULL));
131c4762a1bSJed Brown   /* set the right hand side of U_t = RHSfunction(U,t) */
132*5f80ce2aSJacob Faibussowitsch   CHKERRQ(TSSetRHSFunction(ts,NULL,(PetscErrorCode (*)(TS,PetscScalar,Vec,Vec,void*))RHSfunction,&appctx));
133c4762a1bSJed Brown 
134c4762a1bSJed Brown   if (appctx.useAlhs) {
135c4762a1bSJed Brown     /* set the left hand side matrix of Amat*U_t = rhs(U,t) */
136c4762a1bSJed Brown 
137c4762a1bSJed Brown     /* Note: this approach is incompatible with the finite differenced Jacobian set below because we can't restore the
138c4762a1bSJed Brown      * Alhs matrix without making a copy.  Either finite difference the entire thing or use analytic Jacobians in both
139c4762a1bSJed Brown      * places.
140c4762a1bSJed Brown      */
141*5f80ce2aSJacob Faibussowitsch     CHKERRQ(TSSetIFunction(ts,NULL,TSComputeIFunctionLinear,&appctx));
142*5f80ce2aSJacob Faibussowitsch     CHKERRQ(TSSetIJacobian(ts,appctx.Amat,appctx.Amat,TSComputeIJacobianConstant,&appctx));
143c4762a1bSJed Brown   }
144c4762a1bSJed Brown 
145c4762a1bSJed Brown   /* use petsc to compute the jacobian by finite differences */
146*5f80ce2aSJacob Faibussowitsch   CHKERRQ(TSGetSNES(ts,&snes));
147*5f80ce2aSJacob Faibussowitsch   CHKERRQ(SNESSetJacobian(snes,Jmat,Jmat,SNESComputeJacobianDefault,NULL));
148c4762a1bSJed Brown 
149c4762a1bSJed Brown   /* get the command line options if there are any and set them */
150*5f80ce2aSJacob Faibussowitsch   CHKERRQ(TSSetFromOptions(ts));
151c4762a1bSJed Brown 
152e808b789SPatrick Sanan #if defined(PETSC_HAVE_SUNDIALS2)
153c4762a1bSJed Brown   {
154c4762a1bSJed Brown     TSType    type;
155c4762a1bSJed Brown     PetscBool sundialstype=PETSC_FALSE;
156*5f80ce2aSJacob Faibussowitsch     CHKERRQ(TSGetType(ts,&type));
157*5f80ce2aSJacob Faibussowitsch     CHKERRQ(PetscObjectTypeCompare((PetscObject)ts,TSSUNDIALS,&sundialstype));
1583c633725SBarry Smith     PetscCheck(!sundialstype || !appctx.useAlhs,PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot use Alhs formulation for TSSUNDIALS type");
159c4762a1bSJed Brown   }
160c4762a1bSJed Brown #endif
161c4762a1bSJed Brown   /* Sets the initial solution */
162*5f80ce2aSJacob Faibussowitsch   CHKERRQ(TSSetSolution(ts,init_sol));
163c4762a1bSJed Brown 
164c4762a1bSJed Brown   stepsz[0] = 1.0/(2.0*(nz-1)*(nz-1)); /* (mesh_size)^2/2.0 */
165c4762a1bSJed Brown   ftime     = 0.0;
166c4762a1bSJed Brown   for (k=0; k<nphase; k++) {
167*5f80ce2aSJacob Faibussowitsch     if (nphase > 1) CHKERRQ(PetscPrintf(PETSC_COMM_WORLD,"Phase %D initial time %g, stepsz %g, duration: %g\n",k,(double)ftime,(double)stepsz[k],(double)((k+1)*T)));
168*5f80ce2aSJacob Faibussowitsch     CHKERRQ(TSSetTime(ts,ftime));
169*5f80ce2aSJacob Faibussowitsch     CHKERRQ(TSSetTimeStep(ts,stepsz[k]));
170*5f80ce2aSJacob Faibussowitsch     CHKERRQ(TSSetMaxSteps(ts,max_steps));
171*5f80ce2aSJacob Faibussowitsch     CHKERRQ(TSSetMaxTime(ts,(k+1)*T));
172*5f80ce2aSJacob Faibussowitsch     CHKERRQ(TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER));
173c4762a1bSJed Brown 
174c4762a1bSJed Brown     /* loop over time steps */
175c4762a1bSJed Brown     /*----------------------*/
176*5f80ce2aSJacob Faibussowitsch     CHKERRQ(TSSolve(ts,init_sol));
177*5f80ce2aSJacob Faibussowitsch     CHKERRQ(TSGetSolveTime(ts,&ftime));
178*5f80ce2aSJacob Faibussowitsch     CHKERRQ(TSGetStepNumber(ts,&steps));
179c4762a1bSJed Brown     stepsz[k+1] = stepsz[k]*1.5; /* change step size for the next phase */
180c4762a1bSJed Brown   }
181c4762a1bSJed Brown 
182c4762a1bSJed Brown   /* free space */
183*5f80ce2aSJacob Faibussowitsch   CHKERRQ(TSDestroy(&ts));
184*5f80ce2aSJacob Faibussowitsch   CHKERRQ(MatDestroy(&appctx.Amat));
185*5f80ce2aSJacob Faibussowitsch   CHKERRQ(MatDestroy(&Jmat));
186*5f80ce2aSJacob Faibussowitsch   CHKERRQ(VecDestroy(&appctx.ksp_rhs));
187*5f80ce2aSJacob Faibussowitsch   CHKERRQ(VecDestroy(&appctx.ksp_sol));
188*5f80ce2aSJacob Faibussowitsch   CHKERRQ(VecDestroy(&init_sol));
189*5f80ce2aSJacob Faibussowitsch   CHKERRQ(VecDestroy(&appctx.solution));
190*5f80ce2aSJacob Faibussowitsch   CHKERRQ(PetscFree(z));
191c4762a1bSJed Brown 
192c4762a1bSJed Brown   ierr = PetscFinalize();
193c4762a1bSJed Brown   return ierr;
194c4762a1bSJed Brown }
195c4762a1bSJed Brown 
196c4762a1bSJed Brown /*------------------------------------------------------------------------
197c4762a1bSJed Brown   Set exact solution
198c4762a1bSJed Brown   u(z,t) = sin(6*PI*z)*exp(-36.*PI*PI*t) + 3.*sin(2*PI*z)*exp(-4.*PI*PI*t)
199c4762a1bSJed Brown --------------------------------------------------------------------------*/
200c4762a1bSJed Brown PetscScalar exact(PetscScalar z,PetscReal t)
201c4762a1bSJed Brown {
202c4762a1bSJed Brown   PetscScalar val, ex1, ex2;
203c4762a1bSJed Brown 
204c4762a1bSJed Brown   ex1 = PetscExpReal(-36.*PETSC_PI*PETSC_PI*t);
205c4762a1bSJed Brown   ex2 = PetscExpReal(-4.*PETSC_PI*PETSC_PI*t);
206c4762a1bSJed Brown   val = PetscSinScalar(6*PETSC_PI*z)*ex1 + 3.*PetscSinScalar(2*PETSC_PI*z)*ex2;
207c4762a1bSJed Brown   return val;
208c4762a1bSJed Brown }
209c4762a1bSJed Brown 
210c4762a1bSJed Brown /*
211c4762a1bSJed Brown    Monitor - User-provided routine to monitor the solution computed at
212c4762a1bSJed Brown    each timestep.  This example plots the solution and computes the
213c4762a1bSJed Brown    error in two different norms.
214c4762a1bSJed Brown 
215c4762a1bSJed Brown    Input Parameters:
216c4762a1bSJed Brown    ts     - the timestep context
217c4762a1bSJed Brown    step   - the count of the current step (with 0 meaning the
218c4762a1bSJed Brown              initial condition)
219c4762a1bSJed Brown    time   - the current time
220c4762a1bSJed Brown    u      - the solution at this timestep
221c4762a1bSJed Brown    ctx    - the user-provided context for this monitoring routine.
222c4762a1bSJed Brown             In this case we use the application context which contains
223c4762a1bSJed Brown             information about the problem size, workspace and the exact
224c4762a1bSJed Brown             solution.
225c4762a1bSJed Brown */
226c4762a1bSJed Brown PetscErrorCode Monitor(TS ts,PetscInt step,PetscReal time,Vec u,void *ctx)
227c4762a1bSJed Brown {
228c4762a1bSJed Brown   AppCtx         *appctx = (AppCtx*)ctx;
229c4762a1bSJed Brown   PetscInt       i,m=appctx->m;
230c4762a1bSJed Brown   PetscReal      norm_2,norm_max,h=1.0/(m+1);
231c4762a1bSJed Brown   PetscScalar    *u_exact;
232c4762a1bSJed Brown 
233c4762a1bSJed Brown   /* Compute the exact solution */
234*5f80ce2aSJacob Faibussowitsch   CHKERRQ(VecGetArrayWrite(appctx->solution,&u_exact));
235c4762a1bSJed Brown   for (i=0; i<m; i++) u_exact[i] = exact(appctx->z[i+1],time);
236*5f80ce2aSJacob Faibussowitsch   CHKERRQ(VecRestoreArrayWrite(appctx->solution,&u_exact));
237c4762a1bSJed Brown 
238c4762a1bSJed Brown   /* Print debugging information if desired */
239c4762a1bSJed Brown   if (appctx->debug) {
240*5f80ce2aSJacob Faibussowitsch     CHKERRQ(PetscPrintf(PETSC_COMM_SELF,"Computed solution vector at time %g\n",(double)time));
241*5f80ce2aSJacob Faibussowitsch     CHKERRQ(VecView(u,PETSC_VIEWER_STDOUT_SELF));
242*5f80ce2aSJacob Faibussowitsch     CHKERRQ(PetscPrintf(PETSC_COMM_SELF,"Exact solution vector\n"));
243*5f80ce2aSJacob Faibussowitsch     CHKERRQ(VecView(appctx->solution,PETSC_VIEWER_STDOUT_SELF));
244c4762a1bSJed Brown   }
245c4762a1bSJed Brown 
246c4762a1bSJed Brown   /* Compute the 2-norm and max-norm of the error */
247*5f80ce2aSJacob Faibussowitsch   CHKERRQ(VecAXPY(appctx->solution,-1.0,u));
248*5f80ce2aSJacob Faibussowitsch   CHKERRQ(VecNorm(appctx->solution,NORM_2,&norm_2));
249c4762a1bSJed Brown 
250c4762a1bSJed Brown   norm_2 = PetscSqrtReal(h)*norm_2;
251*5f80ce2aSJacob Faibussowitsch   CHKERRQ(VecNorm(appctx->solution,NORM_MAX,&norm_max));
252*5f80ce2aSJacob Faibussowitsch   CHKERRQ(PetscPrintf(PETSC_COMM_SELF,"Timestep %D: time = %g, 2-norm error = %6.4f, max norm error = %6.4f\n",step,(double)time,(double)norm_2,(double)norm_max));
253c4762a1bSJed Brown 
254c4762a1bSJed Brown   /*
255c4762a1bSJed Brown      Print debugging information if desired
256c4762a1bSJed Brown   */
257c4762a1bSJed Brown   if (appctx->debug) {
258*5f80ce2aSJacob Faibussowitsch     CHKERRQ(PetscPrintf(PETSC_COMM_SELF,"Error vector\n"));
259*5f80ce2aSJacob Faibussowitsch     CHKERRQ(VecView(appctx->solution,PETSC_VIEWER_STDOUT_SELF));
260c4762a1bSJed Brown   }
261c4762a1bSJed Brown   return 0;
262c4762a1bSJed Brown }
263c4762a1bSJed Brown 
264c4762a1bSJed Brown /*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2650e3d61c9SBarry Smith       Function to solve a linear system using KSP
266c4762a1bSJed Brown %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*/
267c4762a1bSJed Brown 
268c4762a1bSJed Brown PetscErrorCode Petsc_KSPSolve(AppCtx *obj)
269c4762a1bSJed Brown {
270c4762a1bSJed Brown   KSP            ksp;
271c4762a1bSJed Brown   PC             pc;
272c4762a1bSJed Brown 
273c4762a1bSJed Brown   /*create the ksp context and set the operators,that is, associate the system matrix with it*/
274*5f80ce2aSJacob Faibussowitsch   CHKERRQ(KSPCreate(PETSC_COMM_WORLD,&ksp));
275*5f80ce2aSJacob Faibussowitsch   CHKERRQ(KSPSetOperators(ksp,obj->Amat,obj->Amat));
276c4762a1bSJed Brown 
277c4762a1bSJed Brown   /*get the preconditioner context, set its type and the tolerances*/
278*5f80ce2aSJacob Faibussowitsch   CHKERRQ(KSPGetPC(ksp,&pc));
279*5f80ce2aSJacob Faibussowitsch   CHKERRQ(PCSetType(pc,PCLU));
280*5f80ce2aSJacob Faibussowitsch   CHKERRQ(KSPSetTolerances(ksp,1.e-7,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT));
281c4762a1bSJed Brown 
282c4762a1bSJed Brown   /*get the command line options if there are any and set them*/
283*5f80ce2aSJacob Faibussowitsch   CHKERRQ(KSPSetFromOptions(ksp));
284c4762a1bSJed Brown 
285c4762a1bSJed Brown   /*get the linear system (ksp) solve*/
286*5f80ce2aSJacob Faibussowitsch   CHKERRQ(KSPSolve(ksp,obj->ksp_rhs,obj->ksp_sol));
287c4762a1bSJed Brown 
288*5f80ce2aSJacob Faibussowitsch   CHKERRQ(KSPDestroy(&ksp));
289c4762a1bSJed Brown   return 0;
290c4762a1bSJed Brown }
291c4762a1bSJed Brown 
292c4762a1bSJed Brown /***********************************************************************
2930e3d61c9SBarry Smith   Function to return value of basis function or derivative of basis function.
294c4762a1bSJed Brown  ***********************************************************************
2950e3d61c9SBarry Smith 
2960e3d61c9SBarry Smith         Arguments:
2970e3d61c9SBarry Smith           x       = array of xpoints or nodal values
2980e3d61c9SBarry Smith           xx      = point at which the basis function is to be
2990e3d61c9SBarry Smith                       evaluated.
3000e3d61c9SBarry Smith           il      = interval containing xx.
3010e3d61c9SBarry Smith           iq      = indicates which of the two basis functions in
3020e3d61c9SBarry Smith                       interval intrvl should be used
3030e3d61c9SBarry Smith           nll     = array containing the endpoints of each interval.
3040e3d61c9SBarry Smith           id      = If id ~= 2, the value of the basis function
3050e3d61c9SBarry Smith                       is calculated; if id = 2, the value of the
3060e3d61c9SBarry Smith                       derivative of the basis function is returned.
307c4762a1bSJed Brown  ***********************************************************************/
308c4762a1bSJed Brown 
309c4762a1bSJed Brown PetscScalar bspl(PetscScalar *x, PetscScalar xx,PetscInt il,PetscInt iq,PetscInt nll[][2],PetscInt id)
310c4762a1bSJed Brown {
311c4762a1bSJed Brown   PetscScalar x1,x2,bfcn;
312c4762a1bSJed Brown   PetscInt    i1,i2,iq1,iq2;
313c4762a1bSJed Brown 
3140e3d61c9SBarry Smith   /* Determine which basis function in interval intrvl is to be used in */
315c4762a1bSJed Brown   iq1 = iq;
316c4762a1bSJed Brown   if (iq1==0) iq2 = 1;
317c4762a1bSJed Brown   else iq2 = 0;
318c4762a1bSJed Brown 
3190e3d61c9SBarry Smith   /*    Determine endpoint of the interval intrvl   */
320c4762a1bSJed Brown   i1=nll[il][iq1];
321c4762a1bSJed Brown   i2=nll[il][iq2];
322c4762a1bSJed Brown 
3230e3d61c9SBarry Smith   /*   Determine nodal values at the endpoints of the interval intrvl   */
324c4762a1bSJed Brown   x1=x[i1];
325c4762a1bSJed Brown   x2=x[i2];
326303a5415SBarry Smith 
3270e3d61c9SBarry Smith   /*   Evaluate basis function   */
328c4762a1bSJed Brown   if (id == 2) bfcn=(1.0)/(x1-x2);
329c4762a1bSJed Brown   else bfcn=(xx-x2)/(x1-x2);
330c4762a1bSJed Brown   return bfcn;
331c4762a1bSJed Brown }
332c4762a1bSJed Brown 
333c4762a1bSJed Brown /*---------------------------------------------------------
334c4762a1bSJed Brown   Function called by rhs function to get B and g
335c4762a1bSJed Brown ---------------------------------------------------------*/
336c4762a1bSJed Brown PetscErrorCode femBg(PetscScalar btri[][3],PetscScalar *f,PetscInt nz,PetscScalar *z, PetscReal t)
337c4762a1bSJed Brown {
338c4762a1bSJed Brown   PetscInt    i,j,jj,il,ip,ipp,ipq,iq,iquad,iqq;
339c4762a1bSJed Brown   PetscInt    nli[num_z][2],indx[num_z];
340c4762a1bSJed Brown   PetscScalar dd,dl,zip,zipq,zz,b_z,bb_z,bij;
341c4762a1bSJed Brown   PetscScalar zquad[num_z][3],dlen[num_z],qdwt[3];
342c4762a1bSJed Brown 
343c4762a1bSJed Brown   /*  initializing everything - btri and f are initialized in rhs.c  */
344c4762a1bSJed Brown   for (i=0; i < nz; i++) {
345c4762a1bSJed Brown     nli[i][0]   = 0;
346c4762a1bSJed Brown     nli[i][1]   = 0;
347c4762a1bSJed Brown     indx[i]     = 0;
348c4762a1bSJed Brown     zquad[i][0] = 0.0;
349c4762a1bSJed Brown     zquad[i][1] = 0.0;
350c4762a1bSJed Brown     zquad[i][2] = 0.0;
351c4762a1bSJed Brown     dlen[i]     = 0.0;
352c4762a1bSJed Brown   } /*end for (i)*/
353c4762a1bSJed Brown 
354c4762a1bSJed Brown   /*  quadrature weights  */
355c4762a1bSJed Brown   qdwt[0] = 1.0/6.0;
356c4762a1bSJed Brown   qdwt[1] = 4.0/6.0;
357c4762a1bSJed Brown   qdwt[2] = 1.0/6.0;
358c4762a1bSJed Brown 
359c4762a1bSJed Brown   /* 1st and last nodes have Dirichlet boundary condition -
360c4762a1bSJed Brown      set indices there to -1 */
361c4762a1bSJed Brown 
362c4762a1bSJed Brown   for (i=0; i < nz-1; i++) indx[i] = i-1;
363c4762a1bSJed Brown   indx[nz-1] = -1;
364c4762a1bSJed Brown 
365c4762a1bSJed Brown   ipq = 0;
366c4762a1bSJed Brown   for (il=0; il < nz-1; il++) {
367c4762a1bSJed Brown     ip           = ipq;
368c4762a1bSJed Brown     ipq          = ip+1;
369c4762a1bSJed Brown     zip          = z[ip];
370c4762a1bSJed Brown     zipq         = z[ipq];
371c4762a1bSJed Brown     dl           = zipq-zip;
372c4762a1bSJed Brown     zquad[il][0] = zip;
373c4762a1bSJed Brown     zquad[il][1] = (0.5)*(zip+zipq);
374c4762a1bSJed Brown     zquad[il][2] = zipq;
375c4762a1bSJed Brown     dlen[il]     = PetscAbsScalar(dl);
376c4762a1bSJed Brown     nli[il][0]   = ip;
377c4762a1bSJed Brown     nli[il][1]   = ipq;
378c4762a1bSJed Brown   }
379c4762a1bSJed Brown 
380c4762a1bSJed Brown   for (il=0; il < nz-1; il++) {
381c4762a1bSJed Brown     for (iquad=0; iquad < 3; iquad++) {
382c4762a1bSJed Brown       dd = (dlen[il])*(qdwt[iquad]);
383c4762a1bSJed Brown       zz = zquad[il][iquad];
384c4762a1bSJed Brown 
385c4762a1bSJed Brown       for (iq=0; iq < 2; iq++) {
386c4762a1bSJed Brown         ip  = nli[il][iq];
387c4762a1bSJed Brown         b_z = bspl(z,zz,il,iq,nli,2);
388c4762a1bSJed Brown         i   = indx[ip];
389c4762a1bSJed Brown 
390c4762a1bSJed Brown         if (i > -1) {
391c4762a1bSJed Brown           for (iqq=0; iqq < 2; iqq++) {
392c4762a1bSJed Brown             ipp  = nli[il][iqq];
393c4762a1bSJed Brown             bb_z = bspl(z,zz,il,iqq,nli,2);
394c4762a1bSJed Brown             j    = indx[ipp];
395c4762a1bSJed Brown             bij  = -b_z*bb_z;
396c4762a1bSJed Brown 
397c4762a1bSJed Brown             if (j > -1) {
398c4762a1bSJed Brown               jj = 1+j-i;
399c4762a1bSJed Brown               btri[i][jj] += bij*dd;
400c4762a1bSJed Brown             } else {
401c4762a1bSJed Brown               f[i] += bij*dd*exact(z[ipp], t);
402c4762a1bSJed Brown               /* f[i] += 0.0; */
403c4762a1bSJed Brown               /* if (il==0 && j==-1) { */
404c4762a1bSJed Brown               /* f[i] += bij*dd*exact(zz,t); */
405c4762a1bSJed Brown               /* }*/ /*end if*/
406c4762a1bSJed Brown             } /*end else*/
407c4762a1bSJed Brown           } /*end for (iqq)*/
408c4762a1bSJed Brown         } /*end if (i>0)*/
409c4762a1bSJed Brown       } /*end for (iq)*/
410c4762a1bSJed Brown     } /*end for (iquad)*/
411c4762a1bSJed Brown   } /*end for (il)*/
412c4762a1bSJed Brown   return 0;
413c4762a1bSJed Brown }
414c4762a1bSJed Brown 
415c4762a1bSJed Brown PetscErrorCode femA(AppCtx *obj,PetscInt nz,PetscScalar *z)
416c4762a1bSJed Brown {
417c4762a1bSJed Brown   PetscInt       i,j,il,ip,ipp,ipq,iq,iquad,iqq;
418c4762a1bSJed Brown   PetscInt       nli[num_z][2],indx[num_z];
419c4762a1bSJed Brown   PetscScalar    dd,dl,zip,zipq,zz,bb,bbb,aij;
420c4762a1bSJed Brown   PetscScalar    rquad[num_z][3],dlen[num_z],qdwt[3],add_term;
421c4762a1bSJed Brown 
422c4762a1bSJed Brown   /*  initializing everything  */
423c4762a1bSJed Brown   for (i=0; i < nz; i++) {
424c4762a1bSJed Brown     nli[i][0]   = 0;
425c4762a1bSJed Brown     nli[i][1]   = 0;
426c4762a1bSJed Brown     indx[i]     = 0;
427c4762a1bSJed Brown     rquad[i][0] = 0.0;
428c4762a1bSJed Brown     rquad[i][1] = 0.0;
429c4762a1bSJed Brown     rquad[i][2] = 0.0;
430c4762a1bSJed Brown     dlen[i]     = 0.0;
431c4762a1bSJed Brown   } /*end for (i)*/
432c4762a1bSJed Brown 
433c4762a1bSJed Brown   /*  quadrature weights  */
434c4762a1bSJed Brown   qdwt[0] = 1.0/6.0;
435c4762a1bSJed Brown   qdwt[1] = 4.0/6.0;
436c4762a1bSJed Brown   qdwt[2] = 1.0/6.0;
437c4762a1bSJed Brown 
438c4762a1bSJed Brown   /* 1st and last nodes have Dirichlet boundary condition -
439c4762a1bSJed Brown      set indices there to -1 */
440c4762a1bSJed Brown 
441c4762a1bSJed Brown   for (i=0; i < nz-1; i++) indx[i]=i-1;
442c4762a1bSJed Brown   indx[nz-1]=-1;
443c4762a1bSJed Brown 
444c4762a1bSJed Brown   ipq = 0;
445c4762a1bSJed Brown 
446c4762a1bSJed Brown   for (il=0; il < nz-1; il++) {
447c4762a1bSJed Brown     ip           = ipq;
448c4762a1bSJed Brown     ipq          = ip+1;
449c4762a1bSJed Brown     zip          = z[ip];
450c4762a1bSJed Brown     zipq         = z[ipq];
451c4762a1bSJed Brown     dl           = zipq-zip;
452c4762a1bSJed Brown     rquad[il][0] = zip;
453c4762a1bSJed Brown     rquad[il][1] = (0.5)*(zip+zipq);
454c4762a1bSJed Brown     rquad[il][2] = zipq;
455c4762a1bSJed Brown     dlen[il]     = PetscAbsScalar(dl);
456c4762a1bSJed Brown     nli[il][0]   = ip;
457c4762a1bSJed Brown     nli[il][1]   = ipq;
458c4762a1bSJed Brown   } /*end for (il)*/
459c4762a1bSJed Brown 
460c4762a1bSJed Brown   for (il=0; il < nz-1; il++) {
461c4762a1bSJed Brown     for (iquad=0; iquad < 3; iquad++) {
462c4762a1bSJed Brown       dd = (dlen[il])*(qdwt[iquad]);
463c4762a1bSJed Brown       zz = rquad[il][iquad];
464c4762a1bSJed Brown 
465c4762a1bSJed Brown       for (iq=0; iq < 2; iq++) {
466c4762a1bSJed Brown         ip = nli[il][iq];
467c4762a1bSJed Brown         bb = bspl(z,zz,il,iq,nli,1);
468c4762a1bSJed Brown         i = indx[ip];
469c4762a1bSJed Brown         if (i > -1) {
470c4762a1bSJed Brown           for (iqq=0; iqq < 2; iqq++) {
471c4762a1bSJed Brown             ipp = nli[il][iqq];
472c4762a1bSJed Brown             bbb = bspl(z,zz,il,iqq,nli,1);
473c4762a1bSJed Brown             j = indx[ipp];
474c4762a1bSJed Brown             aij = bb*bbb;
475c4762a1bSJed Brown             if (j > -1) {
476c4762a1bSJed Brown               add_term = aij*dd;
477*5f80ce2aSJacob Faibussowitsch               CHKERRQ(MatSetValue(obj->Amat,i,j,add_term,ADD_VALUES));
478c4762a1bSJed Brown             }/*endif*/
479c4762a1bSJed Brown           } /*end for (iqq)*/
480c4762a1bSJed Brown         } /*end if (i>0)*/
481c4762a1bSJed Brown       } /*end for (iq)*/
482c4762a1bSJed Brown     } /*end for (iquad)*/
483c4762a1bSJed Brown   } /*end for (il)*/
484*5f80ce2aSJacob Faibussowitsch   CHKERRQ(MatAssemblyBegin(obj->Amat,MAT_FINAL_ASSEMBLY));
485*5f80ce2aSJacob Faibussowitsch   CHKERRQ(MatAssemblyEnd(obj->Amat,MAT_FINAL_ASSEMBLY));
486c4762a1bSJed Brown   return 0;
487c4762a1bSJed Brown }
488c4762a1bSJed Brown 
489c4762a1bSJed Brown /*---------------------------------------------------------
490c4762a1bSJed Brown         Function to fill the rhs vector with
491c4762a1bSJed Brown         By + g values ****
492c4762a1bSJed Brown ---------------------------------------------------------*/
493c4762a1bSJed Brown PetscErrorCode rhs(AppCtx *obj,PetscScalar *y, PetscInt nz, PetscScalar *z, PetscReal t)
494c4762a1bSJed Brown {
495c4762a1bSJed Brown   PetscInt       i,j,js,je,jj;
496c4762a1bSJed Brown   PetscScalar    val,g[num_z],btri[num_z][3],add_term;
497c4762a1bSJed Brown 
498c4762a1bSJed Brown   for (i=0; i < nz-2; i++) {
499c4762a1bSJed Brown     for (j=0; j <= 2; j++) btri[i][j]=0.0;
500c4762a1bSJed Brown     g[i] = 0.0;
501c4762a1bSJed Brown   }
502c4762a1bSJed Brown 
503c4762a1bSJed Brown   /*  call femBg to set the tri-diagonal b matrix and vector g  */
504c4762a1bSJed Brown   femBg(btri,g,nz,z,t);
505c4762a1bSJed Brown 
506c4762a1bSJed Brown   /*  setting the entries of the right hand side vector  */
507c4762a1bSJed Brown   for (i=0; i < nz-2; i++) {
508c4762a1bSJed Brown     val = 0.0;
509c4762a1bSJed Brown     js  = 0;
510c4762a1bSJed Brown     if (i == 0) js = 1;
511c4762a1bSJed Brown     je = 2;
512c4762a1bSJed Brown     if (i == nz-2) je = 1;
513c4762a1bSJed Brown 
514c4762a1bSJed Brown     for (jj=js; jj <= je; jj++) {
515c4762a1bSJed Brown       j    = i+jj-1;
516c4762a1bSJed Brown       val += (btri[i][jj])*(y[j]);
517c4762a1bSJed Brown     }
518c4762a1bSJed Brown     add_term = val + g[i];
519*5f80ce2aSJacob Faibussowitsch     CHKERRQ(VecSetValue(obj->ksp_rhs,(PetscInt)i,(PetscScalar)add_term,INSERT_VALUES));
520c4762a1bSJed Brown   }
521*5f80ce2aSJacob Faibussowitsch   CHKERRQ(VecAssemblyBegin(obj->ksp_rhs));
522*5f80ce2aSJacob Faibussowitsch   CHKERRQ(VecAssemblyEnd(obj->ksp_rhs));
523c4762a1bSJed Brown   return 0;
524c4762a1bSJed Brown }
525c4762a1bSJed Brown 
526c4762a1bSJed Brown /*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
527c4762a1bSJed Brown %%   Function to form the right hand side of the time-stepping problem.                       %%
528c4762a1bSJed Brown %% -------------------------------------------------------------------------------------------%%
529c4762a1bSJed Brown   if (useAlhs):
530c4762a1bSJed Brown     globalout = By+g
531c4762a1bSJed Brown   else if (!useAlhs):
532c4762a1bSJed Brown     globalout = f(y,t)=Ainv(By+g),
533c4762a1bSJed Brown       in which the ksp solver to transform the problem A*ydot=By+g
534c4762a1bSJed Brown       to the problem ydot=f(y,t)=inv(A)*(By+g)
535c4762a1bSJed Brown %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*/
536c4762a1bSJed Brown 
537c4762a1bSJed Brown PetscErrorCode RHSfunction(TS ts,PetscReal t,Vec globalin,Vec globalout,void *ctx)
538c4762a1bSJed Brown {
539c4762a1bSJed Brown   AppCtx            *obj = (AppCtx*)ctx;
540c4762a1bSJed Brown   PetscScalar       soln[num_z];
541c4762a1bSJed Brown   const PetscScalar *soln_ptr;
542c4762a1bSJed Brown   PetscInt          i,nz=obj->nz;
543c4762a1bSJed Brown   PetscReal         time;
544c4762a1bSJed Brown 
545c4762a1bSJed Brown   /* get the previous solution to compute updated system */
546*5f80ce2aSJacob Faibussowitsch   CHKERRQ(VecGetArrayRead(globalin,&soln_ptr));
547c4762a1bSJed Brown   for (i=0; i < num_z-2; i++) soln[i] = soln_ptr[i];
548*5f80ce2aSJacob Faibussowitsch   CHKERRQ(VecRestoreArrayRead(globalin,&soln_ptr));
549c4762a1bSJed Brown   soln[num_z-1] = 0.0;
550c4762a1bSJed Brown   soln[num_z-2] = 0.0;
551c4762a1bSJed Brown 
552c4762a1bSJed Brown   /* clear out the matrix and rhs for ksp to keep things straight */
553*5f80ce2aSJacob Faibussowitsch   CHKERRQ(VecSet(obj->ksp_rhs,(PetscScalar)0.0));
554c4762a1bSJed Brown 
555c4762a1bSJed Brown   time = t;
556c4762a1bSJed Brown   /* get the updated system */
557c4762a1bSJed Brown   rhs(obj,soln,nz,obj->z,time); /* setup of the By+g rhs */
558c4762a1bSJed Brown 
559c4762a1bSJed Brown   /* do a ksp solve to get the rhs for the ts problem */
560c4762a1bSJed Brown   if (obj->useAlhs) {
561c4762a1bSJed Brown     /* ksp_sol = ksp_rhs */
562*5f80ce2aSJacob Faibussowitsch     CHKERRQ(VecCopy(obj->ksp_rhs,globalout));
563c4762a1bSJed Brown   } else {
564c4762a1bSJed Brown     /* ksp_sol = inv(Amat)*ksp_rhs */
565*5f80ce2aSJacob Faibussowitsch     CHKERRQ(Petsc_KSPSolve(obj));
566*5f80ce2aSJacob Faibussowitsch     CHKERRQ(VecCopy(obj->ksp_sol,globalout));
567c4762a1bSJed Brown   }
568c4762a1bSJed Brown   return 0;
569c4762a1bSJed Brown }
570c4762a1bSJed Brown 
571c4762a1bSJed Brown /*TEST
572c4762a1bSJed Brown 
573c4762a1bSJed Brown     build:
574c4762a1bSJed Brown       requires: !complex
575c4762a1bSJed Brown 
576c4762a1bSJed Brown     test:
577c4762a1bSJed Brown       suffix: euler
578c4762a1bSJed Brown       output_file: output/ex3.out
579c4762a1bSJed Brown 
580c4762a1bSJed Brown     test:
581c4762a1bSJed Brown       suffix: 2
582c4762a1bSJed Brown       args:   -useAlhs
583c4762a1bSJed Brown       output_file: output/ex3.out
584c4762a1bSJed Brown       TODO: Broken because SNESComputeJacobianDefault is incompatible with TSComputeIJacobianConstant
585c4762a1bSJed Brown 
586c4762a1bSJed Brown TEST*/
587