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 TS ts; 50c4762a1bSJed Brown SNES snes; 51c4762a1bSJed Brown Mat Jmat; 52c4762a1bSJed Brown AppCtx appctx; /* user-defined application context */ 53c4762a1bSJed Brown Vec init_sol; /* ts solution vector */ 54c4762a1bSJed Brown PetscMPIInt size; 55c4762a1bSJed Brown 569566063dSJacob Faibussowitsch PetscCall(PetscInitialize(&argc,&argv,(char*)0,help)); 579566063dSJacob Faibussowitsch PetscCallMPI(MPI_Comm_size(PETSC_COMM_WORLD,&size)); 583c633725SBarry Smith PetscCheck(size == 1,PETSC_COMM_SELF,PETSC_ERR_WRONG_MPI_SIZE,"This is a uniprocessor example only"); 59c4762a1bSJed Brown 60c4762a1bSJed Brown /* initializations */ 61c4762a1bSJed Brown zInitial = 0.0; 62c4762a1bSJed Brown zFinal = 1.0; 63c4762a1bSJed Brown nz = num_z; 64c4762a1bSJed Brown m = nz-2; 65c4762a1bSJed Brown appctx.nz = nz; 66c4762a1bSJed Brown max_steps = (PetscInt)10000; 67c4762a1bSJed Brown 68c4762a1bSJed Brown appctx.m = m; 69c4762a1bSJed Brown appctx.max_probsz = nz; 70c4762a1bSJed Brown appctx.debug = PETSC_FALSE; 71c4762a1bSJed Brown appctx.useAlhs = PETSC_FALSE; 72c4762a1bSJed Brown 73d0609cedSBarry Smith PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"",""); 749566063dSJacob Faibussowitsch PetscCall(PetscOptionsName("-debug",NULL,NULL,&appctx.debug)); 759566063dSJacob Faibussowitsch PetscCall(PetscOptionsName("-useAlhs",NULL,NULL,&appctx.useAlhs)); 769566063dSJacob Faibussowitsch PetscCall(PetscOptionsRangeInt("-nphase",NULL,NULL,nphase,&nphase,NULL,1,3)); 77d0609cedSBarry Smith PetscOptionsEnd(); 78303a5415SBarry Smith T = 0.014/nphase; 79303a5415SBarry Smith 80c4762a1bSJed Brown /* create vector to hold ts solution */ 81c4762a1bSJed Brown /*-----------------------------------*/ 829566063dSJacob Faibussowitsch PetscCall(VecCreate(PETSC_COMM_WORLD, &init_sol)); 839566063dSJacob Faibussowitsch PetscCall(VecSetSizes(init_sol, PETSC_DECIDE, m)); 849566063dSJacob Faibussowitsch PetscCall(VecSetFromOptions(init_sol)); 85c4762a1bSJed Brown 86c4762a1bSJed Brown /* create vector to hold true ts soln for comparison */ 879566063dSJacob Faibussowitsch PetscCall(VecDuplicate(init_sol, &appctx.solution)); 88c4762a1bSJed Brown 89c4762a1bSJed Brown /* create LHS matrix Amat */ 90c4762a1bSJed Brown /*------------------------*/ 919566063dSJacob Faibussowitsch PetscCall(MatCreateSeqAIJ(PETSC_COMM_WORLD, m, m, 3, NULL, &appctx.Amat)); 929566063dSJacob Faibussowitsch PetscCall(MatSetFromOptions(appctx.Amat)); 939566063dSJacob Faibussowitsch PetscCall(MatSetUp(appctx.Amat)); 94c4762a1bSJed Brown /* set space grid points - interio points only! */ 959566063dSJacob Faibussowitsch PetscCall(PetscMalloc1(nz+1,&z)); 96c4762a1bSJed Brown for (i=0; i<nz; i++) z[i]=(i)*((zFinal-zInitial)/(nz-1)); 97c4762a1bSJed Brown appctx.z = z; 98c4762a1bSJed Brown femA(&appctx,nz,z); 99c4762a1bSJed Brown 100c4762a1bSJed Brown /* create the jacobian matrix */ 101c4762a1bSJed Brown /*----------------------------*/ 1029566063dSJacob Faibussowitsch PetscCall(MatCreate(PETSC_COMM_WORLD, &Jmat)); 1039566063dSJacob Faibussowitsch PetscCall(MatSetSizes(Jmat,PETSC_DECIDE,PETSC_DECIDE,m,m)); 1049566063dSJacob Faibussowitsch PetscCall(MatSetFromOptions(Jmat)); 1059566063dSJacob Faibussowitsch PetscCall(MatSetUp(Jmat)); 106c4762a1bSJed Brown 107c4762a1bSJed Brown /* create working vectors for formulating rhs=inv(Alhs)*(Arhs*U + g) */ 1089566063dSJacob Faibussowitsch PetscCall(VecDuplicate(init_sol,&appctx.ksp_rhs)); 1099566063dSJacob Faibussowitsch PetscCall(VecDuplicate(init_sol,&appctx.ksp_sol)); 110c4762a1bSJed Brown 1112d4ee042Sprj- /* set initial guess */ 1122d4ee042Sprj- /*-------------------*/ 113c4762a1bSJed Brown for (i=0; i<nz-2; i++) { 114c4762a1bSJed Brown val = exact(z[i+1], 0.0); 1159566063dSJacob Faibussowitsch PetscCall(VecSetValue(init_sol,i,(PetscScalar)val,INSERT_VALUES)); 116c4762a1bSJed Brown } 1179566063dSJacob Faibussowitsch PetscCall(VecAssemblyBegin(init_sol)); 1189566063dSJacob Faibussowitsch PetscCall(VecAssemblyEnd(init_sol)); 119c4762a1bSJed Brown 120c4762a1bSJed Brown /*create a time-stepping context and set the problem type */ 121c4762a1bSJed Brown /*--------------------------------------------------------*/ 1229566063dSJacob Faibussowitsch PetscCall(TSCreate(PETSC_COMM_WORLD, &ts)); 1239566063dSJacob Faibussowitsch PetscCall(TSSetProblemType(ts,TS_NONLINEAR)); 124c4762a1bSJed Brown 125c4762a1bSJed Brown /* set time-step method */ 1269566063dSJacob Faibussowitsch PetscCall(TSSetType(ts,TSCN)); 127c4762a1bSJed Brown 128c4762a1bSJed Brown /* Set optional user-defined monitoring routine */ 1299566063dSJacob Faibussowitsch PetscCall(TSMonitorSet(ts,Monitor,&appctx,NULL)); 130c4762a1bSJed Brown /* set the right hand side of U_t = RHSfunction(U,t) */ 1319566063dSJacob Faibussowitsch PetscCall(TSSetRHSFunction(ts,NULL,(PetscErrorCode (*)(TS,PetscScalar,Vec,Vec,void*))RHSfunction,&appctx)); 132c4762a1bSJed Brown 133c4762a1bSJed Brown if (appctx.useAlhs) { 134c4762a1bSJed Brown /* set the left hand side matrix of Amat*U_t = rhs(U,t) */ 135c4762a1bSJed Brown 136c4762a1bSJed Brown /* Note: this approach is incompatible with the finite differenced Jacobian set below because we can't restore the 137c4762a1bSJed Brown * Alhs matrix without making a copy. Either finite difference the entire thing or use analytic Jacobians in both 138c4762a1bSJed Brown * places. 139c4762a1bSJed Brown */ 1409566063dSJacob Faibussowitsch PetscCall(TSSetIFunction(ts,NULL,TSComputeIFunctionLinear,&appctx)); 1419566063dSJacob Faibussowitsch PetscCall(TSSetIJacobian(ts,appctx.Amat,appctx.Amat,TSComputeIJacobianConstant,&appctx)); 142c4762a1bSJed Brown } 143c4762a1bSJed Brown 144c4762a1bSJed Brown /* use petsc to compute the jacobian by finite differences */ 1459566063dSJacob Faibussowitsch PetscCall(TSGetSNES(ts,&snes)); 1469566063dSJacob Faibussowitsch PetscCall(SNESSetJacobian(snes,Jmat,Jmat,SNESComputeJacobianDefault,NULL)); 147c4762a1bSJed Brown 148c4762a1bSJed Brown /* get the command line options if there are any and set them */ 1499566063dSJacob Faibussowitsch PetscCall(TSSetFromOptions(ts)); 150c4762a1bSJed Brown 151e808b789SPatrick Sanan #if defined(PETSC_HAVE_SUNDIALS2) 152c4762a1bSJed Brown { 153c4762a1bSJed Brown TSType type; 154c4762a1bSJed Brown PetscBool sundialstype=PETSC_FALSE; 1559566063dSJacob Faibussowitsch PetscCall(TSGetType(ts,&type)); 1569566063dSJacob Faibussowitsch PetscCall(PetscObjectTypeCompare((PetscObject)ts,TSSUNDIALS,&sundialstype)); 1573c633725SBarry Smith PetscCheck(!sundialstype || !appctx.useAlhs,PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot use Alhs formulation for TSSUNDIALS type"); 158c4762a1bSJed Brown } 159c4762a1bSJed Brown #endif 160c4762a1bSJed Brown /* Sets the initial solution */ 1619566063dSJacob Faibussowitsch PetscCall(TSSetSolution(ts,init_sol)); 162c4762a1bSJed Brown 163c4762a1bSJed Brown stepsz[0] = 1.0/(2.0*(nz-1)*(nz-1)); /* (mesh_size)^2/2.0 */ 164c4762a1bSJed Brown ftime = 0.0; 165c4762a1bSJed Brown for (k=0; k<nphase; k++) { 166*63a3b9bcSJacob Faibussowitsch if (nphase > 1) PetscCall(PetscPrintf(PETSC_COMM_WORLD,"Phase %" PetscInt_FMT " initial time %g, stepsz %g, duration: %g\n",k,(double)ftime,(double)stepsz[k],(double)((k+1)*T))); 1679566063dSJacob Faibussowitsch PetscCall(TSSetTime(ts,ftime)); 1689566063dSJacob Faibussowitsch PetscCall(TSSetTimeStep(ts,stepsz[k])); 1699566063dSJacob Faibussowitsch PetscCall(TSSetMaxSteps(ts,max_steps)); 1709566063dSJacob Faibussowitsch PetscCall(TSSetMaxTime(ts,(k+1)*T)); 1719566063dSJacob Faibussowitsch PetscCall(TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER)); 172c4762a1bSJed Brown 173c4762a1bSJed Brown /* loop over time steps */ 174c4762a1bSJed Brown /*----------------------*/ 1759566063dSJacob Faibussowitsch PetscCall(TSSolve(ts,init_sol)); 1769566063dSJacob Faibussowitsch PetscCall(TSGetSolveTime(ts,&ftime)); 1779566063dSJacob Faibussowitsch PetscCall(TSGetStepNumber(ts,&steps)); 178c4762a1bSJed Brown stepsz[k+1] = stepsz[k]*1.5; /* change step size for the next phase */ 179c4762a1bSJed Brown } 180c4762a1bSJed Brown 181c4762a1bSJed Brown /* free space */ 1829566063dSJacob Faibussowitsch PetscCall(TSDestroy(&ts)); 1839566063dSJacob Faibussowitsch PetscCall(MatDestroy(&appctx.Amat)); 1849566063dSJacob Faibussowitsch PetscCall(MatDestroy(&Jmat)); 1859566063dSJacob Faibussowitsch PetscCall(VecDestroy(&appctx.ksp_rhs)); 1869566063dSJacob Faibussowitsch PetscCall(VecDestroy(&appctx.ksp_sol)); 1879566063dSJacob Faibussowitsch PetscCall(VecDestroy(&init_sol)); 1889566063dSJacob Faibussowitsch PetscCall(VecDestroy(&appctx.solution)); 1899566063dSJacob Faibussowitsch PetscCall(PetscFree(z)); 190c4762a1bSJed Brown 1919566063dSJacob Faibussowitsch PetscCall(PetscFinalize()); 192b122ec5aSJacob Faibussowitsch return 0; 193c4762a1bSJed Brown } 194c4762a1bSJed Brown 195c4762a1bSJed Brown /*------------------------------------------------------------------------ 196c4762a1bSJed Brown Set exact solution 197c4762a1bSJed Brown u(z,t) = sin(6*PI*z)*exp(-36.*PI*PI*t) + 3.*sin(2*PI*z)*exp(-4.*PI*PI*t) 198c4762a1bSJed Brown --------------------------------------------------------------------------*/ 199c4762a1bSJed Brown PetscScalar exact(PetscScalar z,PetscReal t) 200c4762a1bSJed Brown { 201c4762a1bSJed Brown PetscScalar val, ex1, ex2; 202c4762a1bSJed Brown 203c4762a1bSJed Brown ex1 = PetscExpReal(-36.*PETSC_PI*PETSC_PI*t); 204c4762a1bSJed Brown ex2 = PetscExpReal(-4.*PETSC_PI*PETSC_PI*t); 205c4762a1bSJed Brown val = PetscSinScalar(6*PETSC_PI*z)*ex1 + 3.*PetscSinScalar(2*PETSC_PI*z)*ex2; 206c4762a1bSJed Brown return val; 207c4762a1bSJed Brown } 208c4762a1bSJed Brown 209c4762a1bSJed Brown /* 210c4762a1bSJed Brown Monitor - User-provided routine to monitor the solution computed at 211c4762a1bSJed Brown each timestep. This example plots the solution and computes the 212c4762a1bSJed Brown error in two different norms. 213c4762a1bSJed Brown 214c4762a1bSJed Brown Input Parameters: 215c4762a1bSJed Brown ts - the timestep context 216c4762a1bSJed Brown step - the count of the current step (with 0 meaning the 217c4762a1bSJed Brown initial condition) 218c4762a1bSJed Brown time - the current time 219c4762a1bSJed Brown u - the solution at this timestep 220c4762a1bSJed Brown ctx - the user-provided context for this monitoring routine. 221c4762a1bSJed Brown In this case we use the application context which contains 222c4762a1bSJed Brown information about the problem size, workspace and the exact 223c4762a1bSJed Brown solution. 224c4762a1bSJed Brown */ 225c4762a1bSJed Brown PetscErrorCode Monitor(TS ts,PetscInt step,PetscReal time,Vec u,void *ctx) 226c4762a1bSJed Brown { 227c4762a1bSJed Brown AppCtx *appctx = (AppCtx*)ctx; 228c4762a1bSJed Brown PetscInt i,m=appctx->m; 229c4762a1bSJed Brown PetscReal norm_2,norm_max,h=1.0/(m+1); 230c4762a1bSJed Brown PetscScalar *u_exact; 231c4762a1bSJed Brown 232c4762a1bSJed Brown /* Compute the exact solution */ 2339566063dSJacob Faibussowitsch PetscCall(VecGetArrayWrite(appctx->solution,&u_exact)); 234c4762a1bSJed Brown for (i=0; i<m; i++) u_exact[i] = exact(appctx->z[i+1],time); 2359566063dSJacob Faibussowitsch PetscCall(VecRestoreArrayWrite(appctx->solution,&u_exact)); 236c4762a1bSJed Brown 237c4762a1bSJed Brown /* Print debugging information if desired */ 238c4762a1bSJed Brown if (appctx->debug) { 2399566063dSJacob Faibussowitsch PetscCall(PetscPrintf(PETSC_COMM_SELF,"Computed solution vector at time %g\n",(double)time)); 2409566063dSJacob Faibussowitsch PetscCall(VecView(u,PETSC_VIEWER_STDOUT_SELF)); 2419566063dSJacob Faibussowitsch PetscCall(PetscPrintf(PETSC_COMM_SELF,"Exact solution vector\n")); 2429566063dSJacob Faibussowitsch PetscCall(VecView(appctx->solution,PETSC_VIEWER_STDOUT_SELF)); 243c4762a1bSJed Brown } 244c4762a1bSJed Brown 245c4762a1bSJed Brown /* Compute the 2-norm and max-norm of the error */ 2469566063dSJacob Faibussowitsch PetscCall(VecAXPY(appctx->solution,-1.0,u)); 2479566063dSJacob Faibussowitsch PetscCall(VecNorm(appctx->solution,NORM_2,&norm_2)); 248c4762a1bSJed Brown 249c4762a1bSJed Brown norm_2 = PetscSqrtReal(h)*norm_2; 2509566063dSJacob Faibussowitsch PetscCall(VecNorm(appctx->solution,NORM_MAX,&norm_max)); 251*63a3b9bcSJacob Faibussowitsch PetscCall(PetscPrintf(PETSC_COMM_SELF,"Timestep %" PetscInt_FMT ": time = %g, 2-norm error = %6.4f, max norm error = %6.4f\n",step,(double)time,(double)norm_2,(double)norm_max)); 252c4762a1bSJed Brown 253c4762a1bSJed Brown /* 254c4762a1bSJed Brown Print debugging information if desired 255c4762a1bSJed Brown */ 256c4762a1bSJed Brown if (appctx->debug) { 2579566063dSJacob Faibussowitsch PetscCall(PetscPrintf(PETSC_COMM_SELF,"Error vector\n")); 2589566063dSJacob Faibussowitsch PetscCall(VecView(appctx->solution,PETSC_VIEWER_STDOUT_SELF)); 259c4762a1bSJed Brown } 260c4762a1bSJed Brown return 0; 261c4762a1bSJed Brown } 262c4762a1bSJed Brown 263c4762a1bSJed Brown /*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2640e3d61c9SBarry Smith Function to solve a linear system using KSP 265c4762a1bSJed Brown %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*/ 266c4762a1bSJed Brown 267c4762a1bSJed Brown PetscErrorCode Petsc_KSPSolve(AppCtx *obj) 268c4762a1bSJed Brown { 269c4762a1bSJed Brown KSP ksp; 270c4762a1bSJed Brown PC pc; 271c4762a1bSJed Brown 272c4762a1bSJed Brown /*create the ksp context and set the operators,that is, associate the system matrix with it*/ 2739566063dSJacob Faibussowitsch PetscCall(KSPCreate(PETSC_COMM_WORLD,&ksp)); 2749566063dSJacob Faibussowitsch PetscCall(KSPSetOperators(ksp,obj->Amat,obj->Amat)); 275c4762a1bSJed Brown 276c4762a1bSJed Brown /*get the preconditioner context, set its type and the tolerances*/ 2779566063dSJacob Faibussowitsch PetscCall(KSPGetPC(ksp,&pc)); 2789566063dSJacob Faibussowitsch PetscCall(PCSetType(pc,PCLU)); 2799566063dSJacob Faibussowitsch PetscCall(KSPSetTolerances(ksp,1.e-7,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT)); 280c4762a1bSJed Brown 281c4762a1bSJed Brown /*get the command line options if there are any and set them*/ 2829566063dSJacob Faibussowitsch PetscCall(KSPSetFromOptions(ksp)); 283c4762a1bSJed Brown 284c4762a1bSJed Brown /*get the linear system (ksp) solve*/ 2859566063dSJacob Faibussowitsch PetscCall(KSPSolve(ksp,obj->ksp_rhs,obj->ksp_sol)); 286c4762a1bSJed Brown 2879566063dSJacob Faibussowitsch PetscCall(KSPDestroy(&ksp)); 288c4762a1bSJed Brown return 0; 289c4762a1bSJed Brown } 290c4762a1bSJed Brown 291c4762a1bSJed Brown /*********************************************************************** 2920e3d61c9SBarry Smith Function to return value of basis function or derivative of basis function. 293c4762a1bSJed Brown *********************************************************************** 2940e3d61c9SBarry Smith 2950e3d61c9SBarry Smith Arguments: 2960e3d61c9SBarry Smith x = array of xpoints or nodal values 2970e3d61c9SBarry Smith xx = point at which the basis function is to be 2980e3d61c9SBarry Smith evaluated. 2990e3d61c9SBarry Smith il = interval containing xx. 3000e3d61c9SBarry Smith iq = indicates which of the two basis functions in 3010e3d61c9SBarry Smith interval intrvl should be used 3020e3d61c9SBarry Smith nll = array containing the endpoints of each interval. 3030e3d61c9SBarry Smith id = If id ~= 2, the value of the basis function 3040e3d61c9SBarry Smith is calculated; if id = 2, the value of the 3050e3d61c9SBarry Smith derivative of the basis function is returned. 306c4762a1bSJed Brown ***********************************************************************/ 307c4762a1bSJed Brown 308c4762a1bSJed Brown PetscScalar bspl(PetscScalar *x, PetscScalar xx,PetscInt il,PetscInt iq,PetscInt nll[][2],PetscInt id) 309c4762a1bSJed Brown { 310c4762a1bSJed Brown PetscScalar x1,x2,bfcn; 311c4762a1bSJed Brown PetscInt i1,i2,iq1,iq2; 312c4762a1bSJed Brown 3130e3d61c9SBarry Smith /* Determine which basis function in interval intrvl is to be used in */ 314c4762a1bSJed Brown iq1 = iq; 315c4762a1bSJed Brown if (iq1==0) iq2 = 1; 316c4762a1bSJed Brown else iq2 = 0; 317c4762a1bSJed Brown 3180e3d61c9SBarry Smith /* Determine endpoint of the interval intrvl */ 319c4762a1bSJed Brown i1=nll[il][iq1]; 320c4762a1bSJed Brown i2=nll[il][iq2]; 321c4762a1bSJed Brown 3220e3d61c9SBarry Smith /* Determine nodal values at the endpoints of the interval intrvl */ 323c4762a1bSJed Brown x1=x[i1]; 324c4762a1bSJed Brown x2=x[i2]; 325303a5415SBarry Smith 3260e3d61c9SBarry Smith /* Evaluate basis function */ 327c4762a1bSJed Brown if (id == 2) bfcn=(1.0)/(x1-x2); 328c4762a1bSJed Brown else bfcn=(xx-x2)/(x1-x2); 329c4762a1bSJed Brown return bfcn; 330c4762a1bSJed Brown } 331c4762a1bSJed Brown 332c4762a1bSJed Brown /*--------------------------------------------------------- 333c4762a1bSJed Brown Function called by rhs function to get B and g 334c4762a1bSJed Brown ---------------------------------------------------------*/ 335c4762a1bSJed Brown PetscErrorCode femBg(PetscScalar btri[][3],PetscScalar *f,PetscInt nz,PetscScalar *z, PetscReal t) 336c4762a1bSJed Brown { 337c4762a1bSJed Brown PetscInt i,j,jj,il,ip,ipp,ipq,iq,iquad,iqq; 338c4762a1bSJed Brown PetscInt nli[num_z][2],indx[num_z]; 339c4762a1bSJed Brown PetscScalar dd,dl,zip,zipq,zz,b_z,bb_z,bij; 340c4762a1bSJed Brown PetscScalar zquad[num_z][3],dlen[num_z],qdwt[3]; 341c4762a1bSJed Brown 342c4762a1bSJed Brown /* initializing everything - btri and f are initialized in rhs.c */ 343c4762a1bSJed Brown for (i=0; i < nz; i++) { 344c4762a1bSJed Brown nli[i][0] = 0; 345c4762a1bSJed Brown nli[i][1] = 0; 346c4762a1bSJed Brown indx[i] = 0; 347c4762a1bSJed Brown zquad[i][0] = 0.0; 348c4762a1bSJed Brown zquad[i][1] = 0.0; 349c4762a1bSJed Brown zquad[i][2] = 0.0; 350c4762a1bSJed Brown dlen[i] = 0.0; 351c4762a1bSJed Brown } /*end for (i)*/ 352c4762a1bSJed Brown 353c4762a1bSJed Brown /* quadrature weights */ 354c4762a1bSJed Brown qdwt[0] = 1.0/6.0; 355c4762a1bSJed Brown qdwt[1] = 4.0/6.0; 356c4762a1bSJed Brown qdwt[2] = 1.0/6.0; 357c4762a1bSJed Brown 358c4762a1bSJed Brown /* 1st and last nodes have Dirichlet boundary condition - 359c4762a1bSJed Brown set indices there to -1 */ 360c4762a1bSJed Brown 361c4762a1bSJed Brown for (i=0; i < nz-1; i++) indx[i] = i-1; 362c4762a1bSJed Brown indx[nz-1] = -1; 363c4762a1bSJed Brown 364c4762a1bSJed Brown ipq = 0; 365c4762a1bSJed Brown for (il=0; il < nz-1; il++) { 366c4762a1bSJed Brown ip = ipq; 367c4762a1bSJed Brown ipq = ip+1; 368c4762a1bSJed Brown zip = z[ip]; 369c4762a1bSJed Brown zipq = z[ipq]; 370c4762a1bSJed Brown dl = zipq-zip; 371c4762a1bSJed Brown zquad[il][0] = zip; 372c4762a1bSJed Brown zquad[il][1] = (0.5)*(zip+zipq); 373c4762a1bSJed Brown zquad[il][2] = zipq; 374c4762a1bSJed Brown dlen[il] = PetscAbsScalar(dl); 375c4762a1bSJed Brown nli[il][0] = ip; 376c4762a1bSJed Brown nli[il][1] = ipq; 377c4762a1bSJed Brown } 378c4762a1bSJed Brown 379c4762a1bSJed Brown for (il=0; il < nz-1; il++) { 380c4762a1bSJed Brown for (iquad=0; iquad < 3; iquad++) { 381c4762a1bSJed Brown dd = (dlen[il])*(qdwt[iquad]); 382c4762a1bSJed Brown zz = zquad[il][iquad]; 383c4762a1bSJed Brown 384c4762a1bSJed Brown for (iq=0; iq < 2; iq++) { 385c4762a1bSJed Brown ip = nli[il][iq]; 386c4762a1bSJed Brown b_z = bspl(z,zz,il,iq,nli,2); 387c4762a1bSJed Brown i = indx[ip]; 388c4762a1bSJed Brown 389c4762a1bSJed Brown if (i > -1) { 390c4762a1bSJed Brown for (iqq=0; iqq < 2; iqq++) { 391c4762a1bSJed Brown ipp = nli[il][iqq]; 392c4762a1bSJed Brown bb_z = bspl(z,zz,il,iqq,nli,2); 393c4762a1bSJed Brown j = indx[ipp]; 394c4762a1bSJed Brown bij = -b_z*bb_z; 395c4762a1bSJed Brown 396c4762a1bSJed Brown if (j > -1) { 397c4762a1bSJed Brown jj = 1+j-i; 398c4762a1bSJed Brown btri[i][jj] += bij*dd; 399c4762a1bSJed Brown } else { 400c4762a1bSJed Brown f[i] += bij*dd*exact(z[ipp], t); 401c4762a1bSJed Brown /* f[i] += 0.0; */ 402c4762a1bSJed Brown /* if (il==0 && j==-1) { */ 403c4762a1bSJed Brown /* f[i] += bij*dd*exact(zz,t); */ 404c4762a1bSJed Brown /* }*/ /*end if*/ 405c4762a1bSJed Brown } /*end else*/ 406c4762a1bSJed Brown } /*end for (iqq)*/ 407c4762a1bSJed Brown } /*end if (i>0)*/ 408c4762a1bSJed Brown } /*end for (iq)*/ 409c4762a1bSJed Brown } /*end for (iquad)*/ 410c4762a1bSJed Brown } /*end for (il)*/ 411c4762a1bSJed Brown return 0; 412c4762a1bSJed Brown } 413c4762a1bSJed Brown 414c4762a1bSJed Brown PetscErrorCode femA(AppCtx *obj,PetscInt nz,PetscScalar *z) 415c4762a1bSJed Brown { 416c4762a1bSJed Brown PetscInt i,j,il,ip,ipp,ipq,iq,iquad,iqq; 417c4762a1bSJed Brown PetscInt nli[num_z][2],indx[num_z]; 418c4762a1bSJed Brown PetscScalar dd,dl,zip,zipq,zz,bb,bbb,aij; 419c4762a1bSJed Brown PetscScalar rquad[num_z][3],dlen[num_z],qdwt[3],add_term; 420c4762a1bSJed Brown 421c4762a1bSJed Brown /* initializing everything */ 422c4762a1bSJed Brown for (i=0; i < nz; i++) { 423c4762a1bSJed Brown nli[i][0] = 0; 424c4762a1bSJed Brown nli[i][1] = 0; 425c4762a1bSJed Brown indx[i] = 0; 426c4762a1bSJed Brown rquad[i][0] = 0.0; 427c4762a1bSJed Brown rquad[i][1] = 0.0; 428c4762a1bSJed Brown rquad[i][2] = 0.0; 429c4762a1bSJed Brown dlen[i] = 0.0; 430c4762a1bSJed Brown } /*end for (i)*/ 431c4762a1bSJed Brown 432c4762a1bSJed Brown /* quadrature weights */ 433c4762a1bSJed Brown qdwt[0] = 1.0/6.0; 434c4762a1bSJed Brown qdwt[1] = 4.0/6.0; 435c4762a1bSJed Brown qdwt[2] = 1.0/6.0; 436c4762a1bSJed Brown 437c4762a1bSJed Brown /* 1st and last nodes have Dirichlet boundary condition - 438c4762a1bSJed Brown set indices there to -1 */ 439c4762a1bSJed Brown 440c4762a1bSJed Brown for (i=0; i < nz-1; i++) indx[i]=i-1; 441c4762a1bSJed Brown indx[nz-1]=-1; 442c4762a1bSJed Brown 443c4762a1bSJed Brown ipq = 0; 444c4762a1bSJed Brown 445c4762a1bSJed Brown for (il=0; il < nz-1; il++) { 446c4762a1bSJed Brown ip = ipq; 447c4762a1bSJed Brown ipq = ip+1; 448c4762a1bSJed Brown zip = z[ip]; 449c4762a1bSJed Brown zipq = z[ipq]; 450c4762a1bSJed Brown dl = zipq-zip; 451c4762a1bSJed Brown rquad[il][0] = zip; 452c4762a1bSJed Brown rquad[il][1] = (0.5)*(zip+zipq); 453c4762a1bSJed Brown rquad[il][2] = zipq; 454c4762a1bSJed Brown dlen[il] = PetscAbsScalar(dl); 455c4762a1bSJed Brown nli[il][0] = ip; 456c4762a1bSJed Brown nli[il][1] = ipq; 457c4762a1bSJed Brown } /*end for (il)*/ 458c4762a1bSJed Brown 459c4762a1bSJed Brown for (il=0; il < nz-1; il++) { 460c4762a1bSJed Brown for (iquad=0; iquad < 3; iquad++) { 461c4762a1bSJed Brown dd = (dlen[il])*(qdwt[iquad]); 462c4762a1bSJed Brown zz = rquad[il][iquad]; 463c4762a1bSJed Brown 464c4762a1bSJed Brown for (iq=0; iq < 2; iq++) { 465c4762a1bSJed Brown ip = nli[il][iq]; 466c4762a1bSJed Brown bb = bspl(z,zz,il,iq,nli,1); 467c4762a1bSJed Brown i = indx[ip]; 468c4762a1bSJed Brown if (i > -1) { 469c4762a1bSJed Brown for (iqq=0; iqq < 2; iqq++) { 470c4762a1bSJed Brown ipp = nli[il][iqq]; 471c4762a1bSJed Brown bbb = bspl(z,zz,il,iqq,nli,1); 472c4762a1bSJed Brown j = indx[ipp]; 473c4762a1bSJed Brown aij = bb*bbb; 474c4762a1bSJed Brown if (j > -1) { 475c4762a1bSJed Brown add_term = aij*dd; 4769566063dSJacob Faibussowitsch PetscCall(MatSetValue(obj->Amat,i,j,add_term,ADD_VALUES)); 477c4762a1bSJed Brown }/*endif*/ 478c4762a1bSJed Brown } /*end for (iqq)*/ 479c4762a1bSJed Brown } /*end if (i>0)*/ 480c4762a1bSJed Brown } /*end for (iq)*/ 481c4762a1bSJed Brown } /*end for (iquad)*/ 482c4762a1bSJed Brown } /*end for (il)*/ 4839566063dSJacob Faibussowitsch PetscCall(MatAssemblyBegin(obj->Amat,MAT_FINAL_ASSEMBLY)); 4849566063dSJacob Faibussowitsch PetscCall(MatAssemblyEnd(obj->Amat,MAT_FINAL_ASSEMBLY)); 485c4762a1bSJed Brown return 0; 486c4762a1bSJed Brown } 487c4762a1bSJed Brown 488c4762a1bSJed Brown /*--------------------------------------------------------- 489c4762a1bSJed Brown Function to fill the rhs vector with 490c4762a1bSJed Brown By + g values **** 491c4762a1bSJed Brown ---------------------------------------------------------*/ 492c4762a1bSJed Brown PetscErrorCode rhs(AppCtx *obj,PetscScalar *y, PetscInt nz, PetscScalar *z, PetscReal t) 493c4762a1bSJed Brown { 494c4762a1bSJed Brown PetscInt i,j,js,je,jj; 495c4762a1bSJed Brown PetscScalar val,g[num_z],btri[num_z][3],add_term; 496c4762a1bSJed Brown 497c4762a1bSJed Brown for (i=0; i < nz-2; i++) { 498c4762a1bSJed Brown for (j=0; j <= 2; j++) btri[i][j]=0.0; 499c4762a1bSJed Brown g[i] = 0.0; 500c4762a1bSJed Brown } 501c4762a1bSJed Brown 502c4762a1bSJed Brown /* call femBg to set the tri-diagonal b matrix and vector g */ 503c4762a1bSJed Brown femBg(btri,g,nz,z,t); 504c4762a1bSJed Brown 505c4762a1bSJed Brown /* setting the entries of the right hand side vector */ 506c4762a1bSJed Brown for (i=0; i < nz-2; i++) { 507c4762a1bSJed Brown val = 0.0; 508c4762a1bSJed Brown js = 0; 509c4762a1bSJed Brown if (i == 0) js = 1; 510c4762a1bSJed Brown je = 2; 511c4762a1bSJed Brown if (i == nz-2) je = 1; 512c4762a1bSJed Brown 513c4762a1bSJed Brown for (jj=js; jj <= je; jj++) { 514c4762a1bSJed Brown j = i+jj-1; 515c4762a1bSJed Brown val += (btri[i][jj])*(y[j]); 516c4762a1bSJed Brown } 517c4762a1bSJed Brown add_term = val + g[i]; 5189566063dSJacob Faibussowitsch PetscCall(VecSetValue(obj->ksp_rhs,(PetscInt)i,(PetscScalar)add_term,INSERT_VALUES)); 519c4762a1bSJed Brown } 5209566063dSJacob Faibussowitsch PetscCall(VecAssemblyBegin(obj->ksp_rhs)); 5219566063dSJacob Faibussowitsch PetscCall(VecAssemblyEnd(obj->ksp_rhs)); 522c4762a1bSJed Brown return 0; 523c4762a1bSJed Brown } 524c4762a1bSJed Brown 525c4762a1bSJed Brown /*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 526c4762a1bSJed Brown %% Function to form the right hand side of the time-stepping problem. %% 527c4762a1bSJed Brown %% -------------------------------------------------------------------------------------------%% 528c4762a1bSJed Brown if (useAlhs): 529c4762a1bSJed Brown globalout = By+g 530c4762a1bSJed Brown else if (!useAlhs): 531c4762a1bSJed Brown globalout = f(y,t)=Ainv(By+g), 532c4762a1bSJed Brown in which the ksp solver to transform the problem A*ydot=By+g 533c4762a1bSJed Brown to the problem ydot=f(y,t)=inv(A)*(By+g) 534c4762a1bSJed Brown %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*/ 535c4762a1bSJed Brown 536c4762a1bSJed Brown PetscErrorCode RHSfunction(TS ts,PetscReal t,Vec globalin,Vec globalout,void *ctx) 537c4762a1bSJed Brown { 538c4762a1bSJed Brown AppCtx *obj = (AppCtx*)ctx; 539c4762a1bSJed Brown PetscScalar soln[num_z]; 540c4762a1bSJed Brown const PetscScalar *soln_ptr; 541c4762a1bSJed Brown PetscInt i,nz=obj->nz; 542c4762a1bSJed Brown PetscReal time; 543c4762a1bSJed Brown 544c4762a1bSJed Brown /* get the previous solution to compute updated system */ 5459566063dSJacob Faibussowitsch PetscCall(VecGetArrayRead(globalin,&soln_ptr)); 546c4762a1bSJed Brown for (i=0; i < num_z-2; i++) soln[i] = soln_ptr[i]; 5479566063dSJacob Faibussowitsch PetscCall(VecRestoreArrayRead(globalin,&soln_ptr)); 548c4762a1bSJed Brown soln[num_z-1] = 0.0; 549c4762a1bSJed Brown soln[num_z-2] = 0.0; 550c4762a1bSJed Brown 551c4762a1bSJed Brown /* clear out the matrix and rhs for ksp to keep things straight */ 5529566063dSJacob Faibussowitsch PetscCall(VecSet(obj->ksp_rhs,(PetscScalar)0.0)); 553c4762a1bSJed Brown 554c4762a1bSJed Brown time = t; 555c4762a1bSJed Brown /* get the updated system */ 556c4762a1bSJed Brown rhs(obj,soln,nz,obj->z,time); /* setup of the By+g rhs */ 557c4762a1bSJed Brown 558c4762a1bSJed Brown /* do a ksp solve to get the rhs for the ts problem */ 559c4762a1bSJed Brown if (obj->useAlhs) { 560c4762a1bSJed Brown /* ksp_sol = ksp_rhs */ 5619566063dSJacob Faibussowitsch PetscCall(VecCopy(obj->ksp_rhs,globalout)); 562c4762a1bSJed Brown } else { 563c4762a1bSJed Brown /* ksp_sol = inv(Amat)*ksp_rhs */ 5649566063dSJacob Faibussowitsch PetscCall(Petsc_KSPSolve(obj)); 5659566063dSJacob Faibussowitsch PetscCall(VecCopy(obj->ksp_sol,globalout)); 566c4762a1bSJed Brown } 567c4762a1bSJed Brown return 0; 568c4762a1bSJed Brown } 569c4762a1bSJed Brown 570c4762a1bSJed Brown /*TEST 571c4762a1bSJed Brown 572c4762a1bSJed Brown build: 573c4762a1bSJed Brown requires: !complex 574c4762a1bSJed Brown 575c4762a1bSJed Brown test: 576c4762a1bSJed Brown suffix: euler 577c4762a1bSJed Brown output_file: output/ex3.out 578c4762a1bSJed Brown 579c4762a1bSJed Brown test: 580c4762a1bSJed Brown suffix: 2 581c4762a1bSJed Brown args: -useAlhs 582c4762a1bSJed Brown output_file: output/ex3.out 583c4762a1bSJed Brown TODO: Broken because SNESComputeJacobianDefault is incompatible with TSComputeIJacobianConstant 584c4762a1bSJed Brown 585c4762a1bSJed Brown TEST*/ 586