1 /* 2 Code for timestepping with additive Runge-Kutta IMEX method 3 4 Notes: 5 The general system is written as 6 7 F(t,U,Udot) = G(t,U) 8 9 where F represents the stiff part of the physics and G represents the non-stiff part. 10 11 */ 12 #include <petsc-private/tsimpl.h> /*I "petscts.h" I*/ 13 #include <petscdm.h> 14 15 static TSARKIMEXType TSARKIMEXDefault = TSARKIMEX3; 16 static PetscBool TSARKIMEXRegisterAllCalled; 17 static PetscBool TSARKIMEXPackageInitialized; 18 static PetscInt explicit_stage_time_id; 19 static PetscErrorCode TSExtrapolate_ARKIMEX(TS,PetscReal,Vec); 20 21 typedef struct _ARKTableau *ARKTableau; 22 struct _ARKTableau { 23 char *name; 24 PetscInt order; /* Classical approximation order of the method */ 25 PetscInt s; /* Number of stages */ 26 PetscBool stiffly_accurate; /* The implicit part is stiffly accurate*/ 27 PetscBool FSAL_implicit; /* The implicit part is FSAL*/ 28 PetscBool explicit_first_stage; /* The implicit part has an explicit first stage*/ 29 PetscInt pinterp; /* Interpolation order */ 30 PetscReal *At,*bt,*ct; /* Stiff tableau */ 31 PetscReal *A,*b,*c; /* Non-stiff tableau */ 32 PetscReal *bembedt,*bembed; /* Embedded formula of order one less (order-1) */ 33 PetscReal *binterpt,*binterp; /* Dense output formula */ 34 PetscReal ccfl; /* Placeholder for CFL coefficient relative to forward Euler */ 35 }; 36 typedef struct _ARKTableauLink *ARKTableauLink; 37 struct _ARKTableauLink { 38 struct _ARKTableau tab; 39 ARKTableauLink next; 40 }; 41 static ARKTableauLink ARKTableauList; 42 43 typedef struct { 44 ARKTableau tableau; 45 Vec *Y; /* States computed during the step */ 46 Vec *YdotI; /* Time derivatives for the stiff part */ 47 Vec *YdotRHS; /* Function evaluations for the non-stiff part */ 48 PetscBool prev_step_valid; /* Stored previous step (Y_prev, YdotI_prev, YdotRHS_prev) is valid */ 49 Vec *Y_prev; /* States computed during the previous time step */ 50 Vec *YdotI_prev; /* Time derivatives for the stiff part for the previous time step*/ 51 Vec *YdotRHS_prev; /* Function evaluations for the non-stiff part for the previous time step*/ 52 Vec Ydot0; /* Holds the slope from the previous step in FSAL case */ 53 Vec Ydot; /* Work vector holding Ydot during residual evaluation */ 54 Vec Work; /* Generic work vector */ 55 Vec Z; /* Ydot = shift(Y-Z) */ 56 PetscScalar *work; /* Scalar work */ 57 PetscReal scoeff; /* shift = scoeff/dt */ 58 PetscReal stage_time; 59 PetscBool imex; 60 PetscBool init_guess_extrp; /* Extrapolate initial guess from previous time-step stage values */ 61 TSStepStatus status; 62 } TS_ARKIMEX; 63 /*MC 64 TSARKIMEXARS122 - Second order ARK IMEX scheme. 65 66 This method has one explicit stage and one implicit stage. 67 68 References: 69 U. Ascher, S. Ruuth, R. J. Spitheri, Implicit-explicit Runge-Kutta methods for time dependent Partial Differential Equations. Appl. Numer. Math. 25, (1997), pp. 151–167. 70 71 Level: advanced 72 73 .seealso: TSARKIMEX 74 M*/ 75 /*MC 76 TSARKIMEXA2 - Second order ARK IMEX scheme with A-stable implicit part. 77 78 This method has an explicit stage and one implicit stage, and has an A-stable implicit scheme. This method was provided by Emil Constantinescu. 79 80 Level: advanced 81 82 .seealso: TSARKIMEX 83 M*/ 84 /*MC 85 TSARKIMEXL2 - Second order ARK IMEX scheme with L-stable implicit part. 86 87 This method has two implicit stages, and L-stable implicit scheme. 88 89 References: 90 L. Pareschi, G. Russo, Implicit-Explicit Runge-Kutta schemes and applications to hyperbolic systems with relaxations. Journal of Scientific Computing Volume: 25, Issue: 1, October, 2005, pp. 129-155 91 92 Level: advanced 93 94 .seealso: TSARKIMEX 95 M*/ 96 /*MC 97 TSARKIMEX1BEE - First order Backward Euler represented as an ARK IMEX scheme with extrapolation as error estimator. This is a 3-stage method. 98 99 This method is aimed at starting the integration of implicit DAEs when explicit first-stage ARK methods are used. 100 101 Level: advanced 102 103 .seealso: TSARKIMEX 104 M*/ 105 /*MC 106 TSARKIMEX2C - Second order ARK IMEX scheme with L-stable implicit part. 107 108 This method has one explicit stage and two implicit stages. The implicit part is the same as in TSARKIMEX2D and TSARKIMEX2E, but the explicit part has a larger stability region on the negative real axis. This method was provided by Emil Constantinescu. 109 110 Level: advanced 111 112 .seealso: TSARKIMEX 113 M*/ 114 /*MC 115 TSARKIMEX2D - Second order ARK IMEX scheme with L-stable implicit part. 116 117 This method has one explicit stage and two implicit stages. The stability function is independent of the explicit part in the infinity limit of the implict component. This method was provided by Emil Constantinescu. 118 119 Level: advanced 120 121 .seealso: TSARKIMEX 122 M*/ 123 /*MC 124 TSARKIMEX2E - Second order ARK IMEX scheme with L-stable implicit part. 125 126 This method has one explicit stage and two implicit stages. It is is an optimal method developed by Emil Constantinescu. 127 128 Level: advanced 129 130 .seealso: TSARKIMEX 131 M*/ 132 /*MC 133 TSARKIMEXPRSSP2 - Second order SSP ARK IMEX scheme. 134 135 This method has three implicit stages. 136 137 References: 138 L. Pareschi, G. Russo, Implicit-Explicit Runge-Kutta schemes and applications to hyperbolic systems with relaxations. Journal of Scientific Computing Volume: 25, Issue: 1, October, 2005, pp. 129-155 139 140 This method is referred to as SSP2-(3,3,2) in http://arxiv.org/abs/1110.4375 141 142 Level: advanced 143 144 .seealso: TSARKIMEX 145 M*/ 146 /*MC 147 TSARKIMEX3 - Third order ARK IMEX scheme with L-stable implicit part. 148 149 This method has one explicit stage and three implicit stages. 150 151 References: 152 Kennedy and Carpenter 2003. 153 154 Level: advanced 155 156 .seealso: TSARKIMEX 157 M*/ 158 /*MC 159 TSARKIMEXARS443 - Third order ARK IMEX scheme. 160 161 This method has one explicit stage and four implicit stages. 162 163 References: 164 U. Ascher, S. Ruuth, R. J. Spitheri, Implicit-explicit Runge-Kutta methods for time dependent Partial Differential Equations. Appl. Numer. Math. 25, (1997), pp. 151–167. 165 166 This method is referred to as ARS(4,4,3) in http://arxiv.org/abs/1110.4375 167 168 Level: advanced 169 170 .seealso: TSARKIMEX 171 M*/ 172 /*MC 173 TSARKIMEXBPR3 - Third order ARK IMEX scheme. 174 175 This method has one explicit stage and four implicit stages. 176 177 References: 178 This method is referred to as ARK3 in http://arxiv.org/abs/1110.4375 179 180 Level: advanced 181 182 .seealso: TSARKIMEX 183 M*/ 184 /*MC 185 TSARKIMEX4 - Fourth order ARK IMEX scheme with L-stable implicit part. 186 187 This method has one explicit stage and four implicit stages. 188 189 References: 190 Kennedy and Carpenter 2003. 191 192 Level: advanced 193 194 .seealso: TSARKIMEX 195 M*/ 196 /*MC 197 TSARKIMEX5 - Fifth order ARK IMEX scheme with L-stable implicit part. 198 199 This method has one explicit stage and five implicit stages. 200 201 References: 202 Kennedy and Carpenter 2003. 203 204 Level: advanced 205 206 .seealso: TSARKIMEX 207 M*/ 208 209 #undef __FUNCT__ 210 #define __FUNCT__ "TSARKIMEXRegisterAll" 211 /*@C 212 TSARKIMEXRegisterAll - Registers all of the additive Runge-Kutta implicit-explicit methods in TSARKIMEX 213 214 Not Collective, but should be called by all processes which will need the schemes to be registered 215 216 Level: advanced 217 218 .keywords: TS, TSARKIMEX, register, all 219 220 .seealso: TSARKIMEXRegisterDestroy() 221 @*/ 222 PetscErrorCode TSARKIMEXRegisterAll(void) 223 { 224 PetscErrorCode ierr; 225 226 PetscFunctionBegin; 227 if (TSARKIMEXRegisterAllCalled) PetscFunctionReturn(0); 228 TSARKIMEXRegisterAllCalled = PETSC_TRUE; 229 230 { 231 const PetscReal 232 A[3][3] = {{0.0,0.0,0.0}, 233 {0.0,0.0,0.0}, 234 {0.0,0.5,0.0}}, 235 At[3][3] = {{1.0,0.0,0.0}, 236 {0.0,0.5,0.0}, 237 {0.0,0.5,0.5}}, 238 b[3] = {0.0,0.5,0.5}, 239 bembedt[3] = {1.0,0.0,0.0}; 240 ierr = TSARKIMEXRegister(TSARKIMEX1BEE,2,3,&At[0][0],b,NULL,&A[0][0],b,NULL,bembedt,bembedt,1,b,NULL);CHKERRQ(ierr); 241 } 242 { 243 const PetscReal 244 A[2][2] = {{0.0,0.0}, 245 {0.5,0.0}}, 246 At[2][2] = {{0.0,0.0}, 247 {0.0,0.5}}, 248 b[2] = {0.0,1.0}, 249 bembedt[2] = {0.5,0.5}; 250 /* binterpt[2][2] = {{1.0,-1.0},{0.0,1.0}}; second order dense output has poor stability properties and hence it is not currently in use*/ 251 ierr = TSARKIMEXRegister(TSARKIMEXARS122,2,2,&At[0][0],b,NULL,&A[0][0],b,NULL,bembedt,bembedt,1,b,NULL);CHKERRQ(ierr); 252 } 253 { 254 const PetscReal 255 A[2][2] = {{0.0,0.0}, 256 {1.0,0.0}}, 257 At[2][2] = {{0.0,0.0}, 258 {0.5,0.5}}, 259 b[2] = {0.5,0.5}, 260 bembedt[2] = {0.0,1.0}; 261 /* binterpt[2][2] = {{1.0,-0.5},{0.0,0.5}} second order dense output has poor stability properties and hence it is not currently in use*/ 262 ierr = TSARKIMEXRegister(TSARKIMEXA2,2,2,&At[0][0],b,NULL,&A[0][0],b,NULL,bembedt,bembedt,1,b,NULL);CHKERRQ(ierr); 263 } 264 { 265 /* const PetscReal us2 = 1.0-1.0/PetscSqrtReal((PetscReal)2.0); Direct evaluation: 0.2928932188134524755992. Used below to ensure all values are available at compile time */ 266 const PetscReal 267 A[2][2] = {{0.0,0.0}, 268 {1.0,0.0}}, 269 At[2][2] = {{0.2928932188134524755992,0.0}, 270 {1.0-2.0*0.2928932188134524755992,0.2928932188134524755992}}, 271 b[2] = {0.5,0.5}, 272 bembedt[2] = {0.0,1.0}, 273 binterpt[2][2] = {{ (0.2928932188134524755992-1.0)/(2.0*0.2928932188134524755992-1.0),-1/(2.0*(1.0-2.0*0.2928932188134524755992))}, 274 {1-(0.2928932188134524755992-1.0)/(2.0*0.2928932188134524755992-1.0),-1/(2.0*(1.0-2.0*0.2928932188134524755992))}}, 275 binterp[2][2] = {{1.0,-0.5},{0.0,0.5}}; 276 ierr = TSARKIMEXRegister(TSARKIMEXL2,2,2,&At[0][0],b,NULL,&A[0][0],b,NULL,bembedt,bembedt,2,binterpt[0],binterp[0]);CHKERRQ(ierr); 277 } 278 { 279 /* const PetscReal s2 = PetscSqrtReal((PetscReal)2.0), Direct evaluation: 1.414213562373095048802. Used below to ensure all values are available at compile time */ 280 const PetscReal 281 A[3][3] = {{0,0,0}, 282 {2-1.414213562373095048802,0,0}, 283 {0.5,0.5,0}}, 284 At[3][3] = {{0,0,0}, 285 {1-1/1.414213562373095048802,1-1/1.414213562373095048802,0}, 286 {1/(2*1.414213562373095048802),1/(2*1.414213562373095048802),1-1/1.414213562373095048802}}, 287 bembedt[3] = {(4.-1.414213562373095048802)/8.,(4.-1.414213562373095048802)/8.,1/(2.*1.414213562373095048802)}, 288 binterpt[3][2] = {{1.0/1.414213562373095048802,-1.0/(2.0*1.414213562373095048802)}, 289 {1.0/1.414213562373095048802,-1.0/(2.0*1.414213562373095048802)}, 290 {1.0-1.414213562373095048802,1.0/1.414213562373095048802}}; 291 ierr = TSARKIMEXRegister(TSARKIMEX2C,2,3,&At[0][0],NULL,NULL,&A[0][0],NULL,NULL,bembedt,bembedt,2,binterpt[0],NULL);CHKERRQ(ierr); 292 } 293 { 294 /* const PetscReal s2 = PetscSqrtReal((PetscReal)2.0), Direct evaluation: 1.414213562373095048802. Used below to ensure all values are available at compile time */ 295 const PetscReal 296 A[3][3] = {{0,0,0}, 297 {2-1.414213562373095048802,0,0}, 298 {0.75,0.25,0}}, 299 At[3][3] = {{0,0,0}, 300 {1-1/1.414213562373095048802,1-1/1.414213562373095048802,0}, 301 {1/(2*1.414213562373095048802),1/(2*1.414213562373095048802),1-1/1.414213562373095048802}}, 302 bembedt[3] = {(4.-1.414213562373095048802)/8.,(4.-1.414213562373095048802)/8.,1/(2.*1.414213562373095048802)}, 303 binterpt[3][2] = {{1.0/1.414213562373095048802,-1.0/(2.0*1.414213562373095048802)}, 304 {1.0/1.414213562373095048802,-1.0/(2.0*1.414213562373095048802)}, 305 {1.0-1.414213562373095048802,1.0/1.414213562373095048802}}; 306 ierr = TSARKIMEXRegister(TSARKIMEX2D,2,3,&At[0][0],NULL,NULL,&A[0][0],NULL,NULL,bembedt,bembedt,2,binterpt[0],NULL);CHKERRQ(ierr); 307 } 308 { /* Optimal for linear implicit part */ 309 /* const PetscReal s2 = PetscSqrtReal((PetscReal)2.0), Direct evaluation: 1.414213562373095048802. Used below to ensure all values are available at compile time */ 310 const PetscReal 311 A[3][3] = {{0,0,0}, 312 {2-1.414213562373095048802,0,0}, 313 {(3-2*1.414213562373095048802)/6,(3+2*1.414213562373095048802)/6,0}}, 314 At[3][3] = {{0,0,0}, 315 {1-1/1.414213562373095048802,1-1/1.414213562373095048802,0}, 316 {1/(2*1.414213562373095048802),1/(2*1.414213562373095048802),1-1/1.414213562373095048802}}, 317 bembedt[3] = {(4.-1.414213562373095048802)/8.,(4.-1.414213562373095048802)/8.,1/(2.*1.414213562373095048802)}, 318 binterpt[3][2] = {{1.0/1.414213562373095048802,-1.0/(2.0*1.414213562373095048802)}, 319 {1.0/1.414213562373095048802,-1.0/(2.0*1.414213562373095048802)}, 320 {1.0-1.414213562373095048802,1.0/1.414213562373095048802}}; 321 ierr = TSARKIMEXRegister(TSARKIMEX2E,2,3,&At[0][0],NULL,NULL,&A[0][0],NULL,NULL,bembedt,bembedt,2,binterpt[0],NULL);CHKERRQ(ierr); 322 } 323 { /* Optimal for linear implicit part */ 324 const PetscReal 325 A[3][3] = {{0,0,0}, 326 {0.5,0,0}, 327 {0.5,0.5,0}}, 328 At[3][3] = {{0.25,0,0}, 329 {0,0.25,0}, 330 {1./3,1./3,1./3}}; 331 ierr = TSARKIMEXRegister(TSARKIMEXPRSSP2,2,3,&At[0][0],NULL,NULL,&A[0][0],NULL,NULL,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr); 332 } 333 { 334 const PetscReal 335 A[4][4] = {{0,0,0,0}, 336 {1767732205903./2027836641118.,0,0,0}, 337 {5535828885825./10492691773637.,788022342437./10882634858940.,0,0}, 338 {6485989280629./16251701735622.,-4246266847089./9704473918619.,10755448449292./10357097424841.,0}}, 339 At[4][4] = {{0,0,0,0}, 340 {1767732205903./4055673282236.,1767732205903./4055673282236.,0,0}, 341 {2746238789719./10658868560708.,-640167445237./6845629431997.,1767732205903./4055673282236.,0}, 342 {1471266399579./7840856788654.,-4482444167858./7529755066697.,11266239266428./11593286722821.,1767732205903./4055673282236.}}, 343 bembedt[4] = {2756255671327./12835298489170.,-10771552573575./22201958757719.,9247589265047./10645013368117.,2193209047091./5459859503100.}, 344 binterpt[4][2] = {{4655552711362./22874653954995., -215264564351./13552729205753.}, 345 {-18682724506714./9892148508045.,17870216137069./13817060693119.}, 346 {34259539580243./13192909600954.,-28141676662227./17317692491321.}, 347 {584795268549./6622622206610., 2508943948391./7218656332882.}}; 348 ierr = TSARKIMEXRegister(TSARKIMEX3,3,4,&At[0][0],NULL,NULL,&A[0][0],NULL,NULL,bembedt,bembedt,2,binterpt[0],NULL);CHKERRQ(ierr); 349 } 350 { 351 const PetscReal 352 A[5][5] = {{0,0,0,0,0}, 353 {1./2,0,0,0,0}, 354 {11./18,1./18,0,0,0}, 355 {5./6,-5./6,.5,0,0}, 356 {1./4,7./4,3./4,-7./4,0}}, 357 At[5][5] = {{0,0,0,0,0}, 358 {0,1./2,0,0,0}, 359 {0,1./6,1./2,0,0}, 360 {0,-1./2,1./2,1./2,0}, 361 {0,3./2,-3./2,1./2,1./2}}, 362 *bembedt = NULL; 363 ierr = TSARKIMEXRegister(TSARKIMEXARS443,3,5,&At[0][0],NULL,NULL,&A[0][0],NULL,NULL,bembedt,bembedt,0,NULL,NULL);CHKERRQ(ierr); 364 } 365 { 366 const PetscReal 367 A[5][5] = {{0,0,0,0,0}, 368 {1,0,0,0,0}, 369 {4./9,2./9,0,0,0}, 370 {1./4,0,3./4,0,0}, 371 {1./4,0,3./5,0,0}}, 372 At[5][5] = {{0,0,0,0,0}, 373 {.5,.5,0,0,0}, 374 {5./18,-1./9,.5,0,0}, 375 {.5,0,0,.5,0}, 376 {.25,0,.75,-.5,.5}}, 377 *bembedt = NULL; 378 ierr = TSARKIMEXRegister(TSARKIMEXBPR3,3,5,&At[0][0],NULL,NULL,&A[0][0],NULL,NULL,bembedt,bembedt,0,NULL,NULL);CHKERRQ(ierr); 379 } 380 { 381 const PetscReal 382 A[6][6] = {{0,0,0,0,0,0}, 383 {1./2,0,0,0,0,0}, 384 {13861./62500.,6889./62500.,0,0,0,0}, 385 {-116923316275./2393684061468.,-2731218467317./15368042101831.,9408046702089./11113171139209.,0,0,0}, 386 {-451086348788./2902428689909.,-2682348792572./7519795681897.,12662868775082./11960479115383.,3355817975965./11060851509271.,0,0}, 387 {647845179188./3216320057751.,73281519250./8382639484533.,552539513391./3454668386233.,3354512671639./8306763924573.,4040./17871.,0}}, 388 At[6][6] = {{0,0,0,0,0,0}, 389 {1./4,1./4,0,0,0,0}, 390 {8611./62500.,-1743./31250.,1./4,0,0,0}, 391 {5012029./34652500.,-654441./2922500.,174375./388108.,1./4,0,0}, 392 {15267082809./155376265600.,-71443401./120774400.,730878875./902184768.,2285395./8070912.,1./4,0}, 393 {82889./524892.,0,15625./83664.,69875./102672.,-2260./8211,1./4}}, 394 bembedt[6] = {4586570599./29645900160.,0,178811875./945068544.,814220225./1159782912.,-3700637./11593932.,61727./225920.}, 395 binterpt[6][3] = {{6943876665148./7220017795957.,-54480133./30881146.,6818779379841./7100303317025.}, 396 {0,0,0}, 397 {7640104374378./9702883013639.,-11436875./14766696.,2173542590792./12501825683035.}, 398 {-20649996744609./7521556579894.,174696575./18121608.,-31592104683404./5083833661969.}, 399 {8854892464581./2390941311638.,-12120380./966161.,61146701046299./7138195549469.}, 400 {-11397109935349./6675773540249.,3843./706.,-17219254887155./4939391667607.}}; 401 ierr = TSARKIMEXRegister(TSARKIMEX4,4,6,&At[0][0],NULL,NULL,&A[0][0],NULL,NULL,bembedt,bembedt,3,binterpt[0],NULL);CHKERRQ(ierr); 402 } 403 { 404 const PetscReal 405 A[8][8] = {{0,0,0,0,0,0,0,0}, 406 {41./100,0,0,0,0,0,0,0}, 407 {367902744464./2072280473677.,677623207551./8224143866563.,0,0,0,0,0,0}, 408 {1268023523408./10340822734521.,0,1029933939417./13636558850479.,0,0,0,0,0}, 409 {14463281900351./6315353703477.,0,66114435211212./5879490589093.,-54053170152839./4284798021562.,0,0,0,0}, 410 {14090043504691./34967701212078.,0,15191511035443./11219624916014.,-18461159152457./12425892160975.,-281667163811./9011619295870.,0,0,0}, 411 {19230459214898./13134317526959.,0,21275331358303./2942455364971.,-38145345988419./4862620318723.,-1./8,-1./8,0,0}, 412 {-19977161125411./11928030595625.,0,-40795976796054./6384907823539.,177454434618887./12078138498510.,782672205425./8267701900261.,-69563011059811./9646580694205.,7356628210526./4942186776405.,0}}, 413 At[8][8] = {{0,0,0,0,0,0,0,0}, 414 {41./200.,41./200.,0,0,0,0,0,0}, 415 {41./400.,-567603406766./11931857230679.,41./200.,0,0,0,0,0}, 416 {683785636431./9252920307686.,0,-110385047103./1367015193373.,41./200.,0,0,0,0}, 417 {3016520224154./10081342136671.,0,30586259806659./12414158314087.,-22760509404356./11113319521817.,41./200.,0,0,0}, 418 {218866479029./1489978393911.,0,638256894668./5436446318841.,-1179710474555./5321154724896.,-60928119172./8023461067671.,41./200.,0,0}, 419 {1020004230633./5715676835656.,0,25762820946817./25263940353407.,-2161375909145./9755907335909.,-211217309593./5846859502534.,-4269925059573./7827059040749.,41./200,0}, 420 {-872700587467./9133579230613.,0,0,22348218063261./9555858737531.,-1143369518992./8141816002931.,-39379526789629./19018526304540.,32727382324388./42900044865799.,41./200.}}, 421 bembedt[8] = {-975461918565./9796059967033.,0,0,78070527104295./32432590147079.,-548382580838./3424219808633.,-33438840321285./15594753105479.,3629800801594./4656183773603.,4035322873751./18575991585200.}, 422 binterpt[8][3] = {{-17674230611817./10670229744614., 43486358583215./12773830924787., -9257016797708./5021505065439.}, 423 {0, 0, 0 }, 424 {0, 0, 0 }, 425 {65168852399939./7868540260826., -91478233927265./11067650958493., 26096422576131./11239449250142.}, 426 {15494834004392./5936557850923., -79368583304911./10890268929626., 92396832856987./20362823103730.}, 427 {-99329723586156./26959484932159., -12239297817655./9152339842473., 30029262896817./10175596800299.}, 428 {-19024464361622./5461577185407., 115839755401235./10719374521269., -26136350496073./3983972220547.}, 429 {-6511271360970./6095937251113., 5843115559534./2180450260947., -5289405421727./3760307252460. }}; 430 ierr = TSARKIMEXRegister(TSARKIMEX5,5,8,&At[0][0],NULL,NULL,&A[0][0],NULL,NULL,bembedt,bembedt,3,binterpt[0],NULL);CHKERRQ(ierr); 431 } 432 PetscFunctionReturn(0); 433 } 434 435 #undef __FUNCT__ 436 #define __FUNCT__ "TSARKIMEXRegisterDestroy" 437 /*@C 438 TSARKIMEXRegisterDestroy - Frees the list of schemes that were registered by TSARKIMEXRegister(). 439 440 Not Collective 441 442 Level: advanced 443 444 .keywords: TSARKIMEX, register, destroy 445 .seealso: TSARKIMEXRegister(), TSARKIMEXRegisterAll() 446 @*/ 447 PetscErrorCode TSARKIMEXRegisterDestroy(void) 448 { 449 PetscErrorCode ierr; 450 ARKTableauLink link; 451 452 PetscFunctionBegin; 453 while ((link = ARKTableauList)) { 454 ARKTableau t = &link->tab; 455 ARKTableauList = link->next; 456 ierr = PetscFree6(t->At,t->bt,t->ct,t->A,t->b,t->c);CHKERRQ(ierr); 457 ierr = PetscFree2(t->bembedt,t->bembed);CHKERRQ(ierr); 458 ierr = PetscFree2(t->binterpt,t->binterp);CHKERRQ(ierr); 459 ierr = PetscFree(t->name);CHKERRQ(ierr); 460 ierr = PetscFree(link);CHKERRQ(ierr); 461 } 462 TSARKIMEXRegisterAllCalled = PETSC_FALSE; 463 PetscFunctionReturn(0); 464 } 465 466 #undef __FUNCT__ 467 #define __FUNCT__ "TSARKIMEXInitializePackage" 468 /*@C 469 TSARKIMEXInitializePackage - This function initializes everything in the TSARKIMEX package. It is called 470 from PetscDLLibraryRegister() when using dynamic libraries, and on the first call to TSCreate_ARKIMEX() 471 when using static libraries. 472 473 Level: developer 474 475 .keywords: TS, TSARKIMEX, initialize, package 476 .seealso: PetscInitialize() 477 @*/ 478 PetscErrorCode TSARKIMEXInitializePackage(void) 479 { 480 PetscErrorCode ierr; 481 482 PetscFunctionBegin; 483 if (TSARKIMEXPackageInitialized) PetscFunctionReturn(0); 484 TSARKIMEXPackageInitialized = PETSC_TRUE; 485 ierr = TSARKIMEXRegisterAll();CHKERRQ(ierr); 486 ierr = PetscObjectComposedDataRegister(&explicit_stage_time_id);CHKERRQ(ierr); 487 ierr = PetscRegisterFinalize(TSARKIMEXFinalizePackage);CHKERRQ(ierr); 488 PetscFunctionReturn(0); 489 } 490 491 #undef __FUNCT__ 492 #define __FUNCT__ "TSARKIMEXFinalizePackage" 493 /*@C 494 TSARKIMEXFinalizePackage - This function destroys everything in the TSARKIMEX package. It is 495 called from PetscFinalize(). 496 497 Level: developer 498 499 .keywords: Petsc, destroy, package 500 .seealso: PetscFinalize() 501 @*/ 502 PetscErrorCode TSARKIMEXFinalizePackage(void) 503 { 504 PetscErrorCode ierr; 505 506 PetscFunctionBegin; 507 TSARKIMEXPackageInitialized = PETSC_FALSE; 508 ierr = TSARKIMEXRegisterDestroy();CHKERRQ(ierr); 509 PetscFunctionReturn(0); 510 } 511 512 #undef __FUNCT__ 513 #define __FUNCT__ "TSARKIMEXRegister" 514 /*@C 515 TSARKIMEXRegister - register an ARK IMEX scheme by providing the entries in the Butcher tableau and optionally embedded approximations and interpolation 516 517 Not Collective, but the same schemes should be registered on all processes on which they will be used 518 519 Input Parameters: 520 + name - identifier for method 521 . order - approximation order of method 522 . s - number of stages, this is the dimension of the matrices below 523 . At - Butcher table of stage coefficients for stiff part (dimension s*s, row-major) 524 . bt - Butcher table for completing the stiff part of the step (dimension s; NULL to use the last row of At) 525 . ct - Abscissa of each stiff stage (dimension s, NULL to use row sums of At) 526 . A - Non-stiff stage coefficients (dimension s*s, row-major) 527 . b - Non-stiff step completion table (dimension s; NULL to use last row of At) 528 . c - Non-stiff abscissa (dimension s; NULL to use row sums of A) 529 . bembedt - Stiff part of completion table for embedded method (dimension s; NULL if not available) 530 . bembed - Non-stiff part of completion table for embedded method (dimension s; NULL to use bembedt if provided) 531 . pinterp - Order of the interpolation scheme, equal to the number of columns of binterpt and binterp 532 . binterpt - Coefficients of the interpolation formula for the stiff part (dimension s*pinterp) 533 - binterp - Coefficients of the interpolation formula for the non-stiff part (dimension s*pinterp; NULL to reuse binterpt) 534 535 Notes: 536 Several ARK IMEX methods are provided, this function is only needed to create new methods. 537 538 Level: advanced 539 540 .keywords: TS, register 541 542 .seealso: TSARKIMEX 543 @*/ 544 PetscErrorCode TSARKIMEXRegister(TSARKIMEXType name,PetscInt order,PetscInt s, 545 const PetscReal At[],const PetscReal bt[],const PetscReal ct[], 546 const PetscReal A[],const PetscReal b[],const PetscReal c[], 547 const PetscReal bembedt[],const PetscReal bembed[], 548 PetscInt pinterp,const PetscReal binterpt[],const PetscReal binterp[]) 549 { 550 PetscErrorCode ierr; 551 ARKTableauLink link; 552 ARKTableau t; 553 PetscInt i,j; 554 555 PetscFunctionBegin; 556 ierr = PetscMalloc(sizeof(*link),&link);CHKERRQ(ierr); 557 ierr = PetscMemzero(link,sizeof(*link));CHKERRQ(ierr); 558 t = &link->tab; 559 ierr = PetscStrallocpy(name,&t->name);CHKERRQ(ierr); 560 t->order = order; 561 t->s = s; 562 ierr = PetscMalloc6(s*s,PetscReal,&t->At,s,PetscReal,&t->bt,s,PetscReal,&t->ct,s*s,PetscReal,&t->A,s,PetscReal,&t->b,s,PetscReal,&t->c);CHKERRQ(ierr); 563 ierr = PetscMemcpy(t->At,At,s*s*sizeof(At[0]));CHKERRQ(ierr); 564 ierr = PetscMemcpy(t->A,A,s*s*sizeof(A[0]));CHKERRQ(ierr); 565 if (bt) { ierr = PetscMemcpy(t->bt,bt,s*sizeof(bt[0]));CHKERRQ(ierr); } 566 else for (i=0; i<s; i++) t->bt[i] = At[(s-1)*s+i]; 567 if (b) { ierr = PetscMemcpy(t->b,b,s*sizeof(b[0]));CHKERRQ(ierr); } 568 else for (i=0; i<s; i++) t->b[i] = t->bt[i]; 569 if (ct) { ierr = PetscMemcpy(t->ct,ct,s*sizeof(ct[0]));CHKERRQ(ierr); } 570 else for (i=0; i<s; i++) for (j=0,t->ct[i]=0; j<s; j++) t->ct[i] += At[i*s+j]; 571 if (c) { ierr = PetscMemcpy(t->c,c,s*sizeof(c[0]));CHKERRQ(ierr); } 572 else for (i=0; i<s; i++) for (j=0,t->c[i]=0; j<s; j++) t->c[i] += A[i*s+j]; 573 t->stiffly_accurate = PETSC_TRUE; 574 for (i=0; i<s; i++) if (t->At[(s-1)*s+i] != t->bt[i]) t->stiffly_accurate = PETSC_FALSE; 575 t->explicit_first_stage = PETSC_TRUE; 576 for (i=0; i<s; i++) if (t->At[i] != 0.0) t->explicit_first_stage = PETSC_FALSE; 577 /*def of FSAL can be made more precise*/ 578 t->FSAL_implicit = (PetscBool)(t->explicit_first_stage && t->stiffly_accurate); 579 if (bembedt) { 580 ierr = PetscMalloc2(s,PetscReal,&t->bembedt,s,PetscReal,&t->bembed);CHKERRQ(ierr); 581 ierr = PetscMemcpy(t->bembedt,bembedt,s*sizeof(bembedt[0]));CHKERRQ(ierr); 582 ierr = PetscMemcpy(t->bembed,bembed ? bembed : bembedt,s*sizeof(bembed[0]));CHKERRQ(ierr); 583 } 584 585 t->pinterp = pinterp; 586 ierr = PetscMalloc2(s*pinterp,PetscReal,&t->binterpt,s*pinterp,PetscReal,&t->binterp);CHKERRQ(ierr); 587 ierr = PetscMemcpy(t->binterpt,binterpt,s*pinterp*sizeof(binterpt[0]));CHKERRQ(ierr); 588 ierr = PetscMemcpy(t->binterp,binterp ? binterp : binterpt,s*pinterp*sizeof(binterpt[0]));CHKERRQ(ierr); 589 link->next = ARKTableauList; 590 ARKTableauList = link; 591 PetscFunctionReturn(0); 592 } 593 594 #undef __FUNCT__ 595 #define __FUNCT__ "TSEvaluateStep_ARKIMEX" 596 /* 597 The step completion formula is 598 599 x1 = x0 - h bt^T YdotI + h b^T YdotRHS 600 601 This function can be called before or after ts->vec_sol has been updated. 602 Suppose we have a completion formula (bt,b) and an embedded formula (bet,be) of different order. 603 We can write 604 605 x1e = x0 - h bet^T YdotI + h be^T YdotRHS 606 = x1 + h bt^T YdotI - h b^T YdotRHS - h bet^T YdotI + h be^T YdotRHS 607 = x1 - h (bet - bt)^T YdotI + h (be - b)^T YdotRHS 608 609 so we can evaluate the method with different order even after the step has been optimistically completed. 610 */ 611 static PetscErrorCode TSEvaluateStep_ARKIMEX(TS ts,PetscInt order,Vec X,PetscBool *done) 612 { 613 TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data; 614 ARKTableau tab = ark->tableau; 615 PetscScalar *w = ark->work; 616 PetscReal h; 617 PetscInt s = tab->s,j; 618 PetscErrorCode ierr; 619 620 PetscFunctionBegin; 621 switch (ark->status) { 622 case TS_STEP_INCOMPLETE: 623 case TS_STEP_PENDING: 624 h = ts->time_step; break; 625 case TS_STEP_COMPLETE: 626 h = ts->time_step_prev; break; 627 default: SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_PLIB,"Invalid TSStepStatus"); 628 } 629 if (order == tab->order) { 630 if (ark->status == TS_STEP_INCOMPLETE) { 631 if (!ark->imex && tab->stiffly_accurate) { /* Only the stiffly accurate implicit formula is used */ 632 ierr = VecCopy(ark->Y[s-1],X);CHKERRQ(ierr); 633 } else { /* Use the standard completion formula (bt,b) */ 634 ierr = VecCopy(ts->vec_sol,X);CHKERRQ(ierr); 635 for (j=0; j<s; j++) w[j] = h*tab->bt[j]; 636 ierr = VecMAXPY(X,s,w,ark->YdotI);CHKERRQ(ierr); 637 if (ark->imex) { /* Method is IMEX, complete the explicit formula */ 638 for (j=0; j<s; j++) w[j] = h*tab->b[j]; 639 ierr = VecMAXPY(X,s,w,ark->YdotRHS);CHKERRQ(ierr); 640 } 641 } 642 } else {ierr = VecCopy(ts->vec_sol,X);CHKERRQ(ierr);} 643 if (done) *done = PETSC_TRUE; 644 PetscFunctionReturn(0); 645 } else if (order == tab->order-1) { 646 if (!tab->bembedt) goto unavailable; 647 if (ark->status == TS_STEP_INCOMPLETE) { /* Complete with the embedded method (bet,be) */ 648 ierr = VecCopy(ts->vec_sol,X);CHKERRQ(ierr); 649 for (j=0; j<s; j++) w[j] = h*tab->bembedt[j]; 650 ierr = VecMAXPY(X,s,w,ark->YdotI);CHKERRQ(ierr); 651 for (j=0; j<s; j++) w[j] = h*tab->bembed[j]; 652 ierr = VecMAXPY(X,s,w,ark->YdotRHS);CHKERRQ(ierr); 653 } else { /* Rollback and re-complete using (bet-be,be-b) */ 654 ierr = VecCopy(ts->vec_sol,X);CHKERRQ(ierr); 655 for (j=0; j<s; j++) w[j] = h*(tab->bembedt[j] - tab->bt[j]); 656 ierr = VecMAXPY(X,tab->s,w,ark->YdotI);CHKERRQ(ierr); 657 for (j=0; j<s; j++) w[j] = h*(tab->bembed[j] - tab->b[j]); 658 ierr = VecMAXPY(X,s,w,ark->YdotRHS);CHKERRQ(ierr); 659 } 660 if (done) *done = PETSC_TRUE; 661 PetscFunctionReturn(0); 662 } 663 unavailable: 664 if (done) *done = PETSC_FALSE; 665 else SETERRQ3(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"ARKIMEX '%s' of order %D cannot evaluate step at order %D",tab->name,tab->order,order); 666 PetscFunctionReturn(0); 667 } 668 669 #undef __FUNCT__ 670 #define __FUNCT__ "TSStep_ARKIMEX" 671 static PetscErrorCode TSStep_ARKIMEX(TS ts) 672 { 673 TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data; 674 ARKTableau tab = ark->tableau; 675 const PetscInt s = tab->s; 676 const PetscReal *At = tab->At,*A = tab->A,*bt = tab->bt,*b = tab->b,*ct = tab->ct,*c = tab->c; 677 PetscScalar *w = ark->work; 678 Vec *Y = ark->Y,*YdotI = ark->YdotI,*YdotRHS = ark->YdotRHS,Ydot = ark->Ydot,Ydot0 = ark->Ydot0,W = ark->Work,Z = ark->Z; 679 PetscBool init_guess_extrp = ark->init_guess_extrp; 680 TSAdapt adapt; 681 SNES snes; 682 PetscInt i,j,its,lits,reject,next_scheme; 683 PetscReal next_time_step; 684 PetscReal t; 685 PetscBool accept; 686 PetscErrorCode ierr; 687 688 PetscFunctionBegin; 689 if (ts->equation_type >= TS_EQ_IMPLICIT && tab->explicit_first_stage) { 690 PetscReal valid_time; 691 PetscBool isvalid; 692 ierr = PetscObjectComposedDataGetReal((PetscObject)ts->vec_sol, 693 explicit_stage_time_id, 694 valid_time, 695 isvalid); 696 CHKERRQ(ierr); 697 if (!isvalid || valid_time != ts->ptime) { 698 TS ts_start; 699 SNES snes_start; 700 DM dm; 701 PetscReal atol; 702 Vec vatol; 703 PetscReal rtol; 704 Vec vrtol; 705 706 ierr = TSCreate(PetscObjectComm((PetscObject)ts),&ts_start);CHKERRQ(ierr); 707 ierr = TSGetSNES(ts,&snes_start);CHKERRQ(ierr); 708 ierr = TSSetSNES(ts_start,snes_start);CHKERRQ(ierr); 709 ierr = TSGetDM(ts,&dm);CHKERRQ(ierr); 710 ierr = TSSetDM(ts_start,dm);CHKERRQ(ierr); 711 712 ts_start->adapt=ts->adapt; 713 PetscObjectReference((PetscObject)ts_start->adapt); 714 715 ierr = TSSetSolution(ts_start,ts->vec_sol);CHKERRQ(ierr); 716 ierr = TSSetTime(ts_start,ts->ptime);CHKERRQ(ierr); 717 ierr = TSSetDuration(ts_start,1,ts->ptime+ts->time_step);CHKERRQ(ierr); 718 ierr = TSSetTimeStep(ts_start,ts->time_step);CHKERRQ(ierr); 719 ierr = TSSetType(ts_start,TSARKIMEX);CHKERRQ(ierr); 720 ierr = TSARKIMEXSetFullyImplicit(ts_start,PETSC_TRUE);CHKERRQ(ierr); 721 ierr = TSARKIMEXSetType(ts_start,TSARKIMEX1BEE);CHKERRQ(ierr); 722 ierr = TSSetEquationType(ts_start,ts->equation_type);CHKERRQ(ierr); 723 ierr = TSGetTolerances(ts,&atol,&vatol,&rtol,&vrtol);CHKERRQ(ierr); 724 ierr = TSSetTolerances(ts_start,atol,vatol,rtol,vrtol);CHKERRQ(ierr); 725 ierr = TSSolve(ts_start,ts->vec_sol);CHKERRQ(ierr); 726 ierr = TSGetTime(ts_start,&ts->ptime);CHKERRQ(ierr); 727 728 ts->time_step = ts_start->time_step; 729 ts->steps++; 730 ierr = VecCopy(((TS_ARKIMEX*)ts_start->data)->Ydot0,Ydot0);CHKERRQ(ierr); 731 ts_start->snes=NULL; 732 ierr = TSSetSNES(ts,snes_start);CHKERRQ(ierr); 733 ierr = SNESDestroy(&snes_start);CHKERRQ(ierr); 734 ierr = TSDestroy(&ts_start);CHKERRQ(ierr); 735 } 736 } 737 738 ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr); 739 next_time_step = ts->time_step; 740 t = ts->ptime; 741 accept = PETSC_TRUE; 742 ark->status = TS_STEP_INCOMPLETE; 743 744 745 for (reject=0; reject<ts->max_reject && !ts->reason; reject++,ts->reject++) { 746 PetscReal h = ts->time_step; 747 ierr = TSPreStep(ts);CHKERRQ(ierr); 748 for (i=0; i<s; i++) { 749 ark->stage_time = t + h*ct[i]; 750 if (At[i*s+i] == 0) { /* This stage is explicit */ 751 ierr = VecCopy(ts->vec_sol,Y[i]);CHKERRQ(ierr); 752 for (j=0; j<i; j++) w[j] = h*At[i*s+j]; 753 ierr = VecMAXPY(Y[i],i,w,YdotI);CHKERRQ(ierr); 754 for (j=0; j<i; j++) w[j] = h*A[i*s+j]; 755 ierr = VecMAXPY(Y[i],i,w,YdotRHS);CHKERRQ(ierr); 756 } else { 757 ark->scoeff = 1./At[i*s+i]; 758 ierr = TSPreStage(ts,ark->stage_time);CHKERRQ(ierr); 759 /* Affine part */ 760 ierr = VecZeroEntries(W);CHKERRQ(ierr); 761 for (j=0; j<i; j++) w[j] = h*A[i*s+j]; 762 ierr = VecMAXPY(W,i,w,YdotRHS);CHKERRQ(ierr); 763 ierr = VecScale(W, ark->scoeff/h);CHKERRQ(ierr); 764 765 /* Ydot = shift*(Y-Z) */ 766 ierr = VecCopy(ts->vec_sol,Z);CHKERRQ(ierr); 767 for (j=0; j<i; j++) w[j] = h*At[i*s+j]; 768 ierr = VecMAXPY(Z,i,w,YdotI);CHKERRQ(ierr); 769 770 if (init_guess_extrp && ark->prev_step_valid) { 771 /* Initial guess extrapolated from previous time step stage values */ 772 ierr = TSExtrapolate_ARKIMEX(ts,c[i],Y[i]);CHKERRQ(ierr); 773 } else { 774 /* Initial guess taken from last stage */ 775 ierr = VecCopy(i>0 ? Y[i-1] : ts->vec_sol,Y[i]);CHKERRQ(ierr); 776 } 777 ierr = SNESSolve(snes,W,Y[i]);CHKERRQ(ierr); 778 ierr = (ts->ops->snesfunction)(snes,Y[i],W,ts);CHKERRQ(ierr); 779 ierr = SNESGetIterationNumber(snes,&its);CHKERRQ(ierr); 780 ierr = SNESGetLinearSolveIterations(snes,&lits);CHKERRQ(ierr); 781 ts->snes_its += its; ts->ksp_its += lits; 782 ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr); 783 ierr = TSAdaptCheckStage(adapt,ts,&accept);CHKERRQ(ierr); 784 if (!accept) { 785 /* We are likely rejecting the step because of solver or function domain problems so we should not attempt to 786 * use extrapolation to initialize the solves on the next attempt. */ 787 ark->prev_step_valid = PETSC_FALSE; 788 goto reject_step; 789 } 790 } 791 ierr = TSPostStage(ts,ark->stage_time,i,Y); CHKERRQ(ierr); 792 if (ts->equation_type>=TS_EQ_IMPLICIT) { 793 if (i==0 && tab->explicit_first_stage) { 794 ierr = VecCopy(Ydot0,YdotI[0]);CHKERRQ(ierr); 795 } else { 796 ierr = VecAXPBYPCZ(YdotI[i],-ark->scoeff/h,ark->scoeff/h,0,Z,Y[i]);CHKERRQ(ierr); /* Ydot = shift*(X-Z) */ 797 } 798 } else { 799 ierr = VecZeroEntries(Ydot);CHKERRQ(ierr); 800 ierr = TSComputeIFunction(ts,t+h*ct[i],Y[i],Ydot,YdotI[i],ark->imex);CHKERRQ(ierr); 801 ierr = VecScale(YdotI[i], -1.0);CHKERRQ(ierr); 802 if (ark->imex) { 803 ierr = TSComputeRHSFunction(ts,t+h*c[i],Y[i],YdotRHS[i]);CHKERRQ(ierr); 804 } else { 805 ierr = VecZeroEntries(YdotRHS[i]);CHKERRQ(ierr); 806 } 807 } 808 } 809 ierr = TSEvaluateStep(ts,tab->order,ts->vec_sol,NULL);CHKERRQ(ierr); 810 ark->status = TS_STEP_PENDING; 811 812 /* Register only the current method as a candidate because we're not supporting multiple candidates yet. */ 813 ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr); 814 ierr = TSAdaptCandidatesClear(adapt);CHKERRQ(ierr); 815 ierr = TSAdaptCandidateAdd(adapt,tab->name,tab->order,1,tab->ccfl,1.*tab->s,PETSC_TRUE);CHKERRQ(ierr); 816 ierr = TSAdaptChoose(adapt,ts,ts->time_step,&next_scheme,&next_time_step,&accept);CHKERRQ(ierr); 817 if (accept) { 818 /* ignore next_scheme for now */ 819 ts->ptime += ts->time_step; 820 ts->time_step = next_time_step; 821 ts->steps++; 822 if (ts->equation_type>=TS_EQ_IMPLICIT) { /* save the initial slope for the next step*/ 823 ierr = VecCopy(YdotI[s-1],Ydot0);CHKERRQ(ierr); 824 } 825 ark->status = TS_STEP_COMPLETE; 826 if (tab->explicit_first_stage) { 827 ierr = PetscObjectComposedDataSetReal((PetscObject)ts->vec_sol,explicit_stage_time_id,ts->ptime);CHKERRQ(ierr); 828 } 829 /* Save the Y, YdotI, YdotRHS for extrapolation initial guess */ 830 if (ark->init_guess_extrp) { 831 for (i = 0; i<s; i++) { 832 ierr = VecCopy(Y[i],ark->Y_prev[i]);CHKERRQ(ierr); 833 ierr = VecCopy(YdotRHS[i],ark->YdotRHS_prev[i]);CHKERRQ(ierr); 834 ierr = VecCopy(YdotI[i],ark->YdotI_prev[i]);CHKERRQ(ierr); 835 } 836 ark->prev_step_valid = PETSC_TRUE; 837 } 838 break; 839 } else { /* Roll back the current step */ 840 for (j=0; j<s; j++) w[j] = -h*bt[j]; 841 ierr = VecMAXPY(ts->vec_sol,s,w,ark->YdotI);CHKERRQ(ierr); 842 for (j=0; j<s; j++) w[j] = -h*b[j]; 843 ierr = VecMAXPY(ts->vec_sol,s,w,ark->YdotRHS);CHKERRQ(ierr); 844 ts->time_step = next_time_step; 845 ark->status = TS_STEP_INCOMPLETE; 846 } 847 reject_step: continue; 848 } 849 if (ark->status != TS_STEP_COMPLETE && !ts->reason) ts->reason = TS_DIVERGED_STEP_REJECTED; 850 PetscFunctionReturn(0); 851 } 852 853 #undef __FUNCT__ 854 #define __FUNCT__ "TSInterpolate_ARKIMEX" 855 static PetscErrorCode TSInterpolate_ARKIMEX(TS ts,PetscReal itime,Vec X) 856 { 857 TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data; 858 PetscInt s = ark->tableau->s,pinterp = ark->tableau->pinterp,i,j; 859 PetscReal h; 860 PetscReal tt,t; 861 PetscScalar *bt,*b; 862 const PetscReal *Bt = ark->tableau->binterpt,*B = ark->tableau->binterp; 863 PetscErrorCode ierr; 864 865 PetscFunctionBegin; 866 if (!Bt || !B) SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"TSARKIMEX %s does not have an interpolation formula",ark->tableau->name); 867 switch (ark->status) { 868 case TS_STEP_INCOMPLETE: 869 case TS_STEP_PENDING: 870 h = ts->time_step; 871 t = (itime - ts->ptime)/h; 872 break; 873 case TS_STEP_COMPLETE: 874 h = ts->time_step_prev; 875 t = (itime - ts->ptime)/h + 1; /* In the interval [0,1] */ 876 break; 877 default: SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_PLIB,"Invalid TSStepStatus"); 878 } 879 ierr = PetscMalloc2(s,PetscScalar,&bt,s,PetscScalar,&b);CHKERRQ(ierr); 880 for (i=0; i<s; i++) bt[i] = b[i] = 0; 881 for (j=0,tt=t; j<pinterp; j++,tt*=t) { 882 for (i=0; i<s; i++) { 883 bt[i] += h * Bt[i*pinterp+j] * tt; 884 b[i] += h * B[i*pinterp+j] * tt; 885 } 886 } 887 ierr = VecCopy(ark->Y[0],X);CHKERRQ(ierr); 888 ierr = VecMAXPY(X,s,bt,ark->YdotI);CHKERRQ(ierr); 889 ierr = VecMAXPY(X,s,b,ark->YdotRHS);CHKERRQ(ierr); 890 ierr = PetscFree2(bt,b);CHKERRQ(ierr); 891 PetscFunctionReturn(0); 892 } 893 894 #undef __FUNCT__ 895 #define __FUNCT__ "TSExtrapolate_ARKIMEX" 896 static PetscErrorCode TSExtrapolate_ARKIMEX(TS ts,PetscReal c,Vec X) 897 { 898 TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data; 899 PetscInt s = ark->tableau->s,pinterp = ark->tableau->pinterp,i,j; 900 PetscReal h; 901 PetscReal tt,t; 902 PetscScalar *bt,*b; 903 const PetscReal *Bt = ark->tableau->binterpt,*B = ark->tableau->binterp; 904 PetscErrorCode ierr; 905 906 PetscFunctionBegin; 907 if (!Bt || !B) SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"TSARKIMEX %s does not have an interpolation formula",ark->tableau->name); 908 t = 1.0 + (ts->time_step/ts->time_step_prev)*c; 909 h = ts->time_step; 910 ierr = PetscMalloc2(s,PetscScalar,&bt,s,PetscScalar,&b);CHKERRQ(ierr); 911 for (i=0; i<s; i++) bt[i] = b[i] = 0; 912 for (j=0,tt=t; j<pinterp; j++,tt*=t) { 913 for (i=0; i<s; i++) { 914 bt[i] += h * Bt[i*pinterp+j] * tt; 915 b[i] += h * B[i*pinterp+j] * tt; 916 } 917 } 918 if (!ark->prev_step_valid) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"Stages from previous step have not been stored"); 919 ierr = VecCopy(ark->Y_prev[0],X);CHKERRQ(ierr); 920 ierr = VecMAXPY(X,s,bt,ark->YdotI_prev);CHKERRQ(ierr); 921 ierr = VecMAXPY(X,s,b,ark->YdotRHS_prev);CHKERRQ(ierr); 922 ierr = PetscFree2(bt,b);CHKERRQ(ierr); 923 PetscFunctionReturn(0); 924 } 925 926 /*------------------------------------------------------------*/ 927 #undef __FUNCT__ 928 #define __FUNCT__ "TSReset_ARKIMEX" 929 static PetscErrorCode TSReset_ARKIMEX(TS ts) 930 { 931 TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data; 932 PetscInt s; 933 PetscErrorCode ierr; 934 935 PetscFunctionBegin; 936 if (!ark->tableau) PetscFunctionReturn(0); 937 s = ark->tableau->s; 938 ierr = VecDestroyVecs(s,&ark->Y);CHKERRQ(ierr); 939 ierr = VecDestroyVecs(s,&ark->YdotI);CHKERRQ(ierr); 940 ierr = VecDestroyVecs(s,&ark->YdotRHS);CHKERRQ(ierr); 941 if (&ark->init_guess_extrp) { 942 ierr = VecDestroyVecs(s,&ark->Y_prev);CHKERRQ(ierr); 943 ierr = VecDestroyVecs(s,&ark->YdotI_prev);CHKERRQ(ierr); 944 ierr = VecDestroyVecs(s,&ark->YdotRHS_prev);CHKERRQ(ierr); 945 } 946 ierr = VecDestroy(&ark->Ydot);CHKERRQ(ierr); 947 ierr = VecDestroy(&ark->Work);CHKERRQ(ierr); 948 ierr = VecDestroy(&ark->Ydot0);CHKERRQ(ierr); 949 ierr = VecDestroy(&ark->Z);CHKERRQ(ierr); 950 ierr = PetscFree(ark->work);CHKERRQ(ierr); 951 PetscFunctionReturn(0); 952 } 953 954 #undef __FUNCT__ 955 #define __FUNCT__ "TSDestroy_ARKIMEX" 956 static PetscErrorCode TSDestroy_ARKIMEX(TS ts) 957 { 958 PetscErrorCode ierr; 959 960 PetscFunctionBegin; 961 ierr = TSReset_ARKIMEX(ts);CHKERRQ(ierr); 962 ierr = PetscFree(ts->data);CHKERRQ(ierr); 963 ierr = PetscObjectComposeFunction((PetscObject)ts,"TSARKIMEXGetType_C",NULL);CHKERRQ(ierr); 964 ierr = PetscObjectComposeFunction((PetscObject)ts,"TSARKIMEXSetType_C",NULL);CHKERRQ(ierr); 965 ierr = PetscObjectComposeFunction((PetscObject)ts,"TSARKIMEXSetFullyImplicit_C",NULL);CHKERRQ(ierr); 966 PetscFunctionReturn(0); 967 } 968 969 970 #undef __FUNCT__ 971 #define __FUNCT__ "TSARKIMEXGetVecs" 972 static PetscErrorCode TSARKIMEXGetVecs(TS ts,DM dm,Vec *Z,Vec *Ydot) 973 { 974 TS_ARKIMEX *ax = (TS_ARKIMEX*)ts->data; 975 PetscErrorCode ierr; 976 977 PetscFunctionBegin; 978 if (Z) { 979 if (dm && dm != ts->dm) { 980 ierr = DMGetNamedGlobalVector(dm,"TSARKIMEX_Z",Z);CHKERRQ(ierr); 981 } else *Z = ax->Z; 982 } 983 if (Ydot) { 984 if (dm && dm != ts->dm) { 985 ierr = DMGetNamedGlobalVector(dm,"TSARKIMEX_Ydot",Ydot);CHKERRQ(ierr); 986 } else *Ydot = ax->Ydot; 987 } 988 PetscFunctionReturn(0); 989 } 990 991 992 #undef __FUNCT__ 993 #define __FUNCT__ "TSARKIMEXRestoreVecs" 994 static PetscErrorCode TSARKIMEXRestoreVecs(TS ts,DM dm,Vec *Z,Vec *Ydot) 995 { 996 PetscErrorCode ierr; 997 998 PetscFunctionBegin; 999 if (Z) { 1000 if (dm && dm != ts->dm) { 1001 ierr = DMRestoreNamedGlobalVector(dm,"TSARKIMEX_Z",Z);CHKERRQ(ierr); 1002 } 1003 } 1004 if (Ydot) { 1005 if (dm && dm != ts->dm) { 1006 ierr = DMRestoreNamedGlobalVector(dm,"TSARKIMEX_Ydot",Ydot);CHKERRQ(ierr); 1007 } 1008 } 1009 PetscFunctionReturn(0); 1010 } 1011 1012 /* 1013 This defines the nonlinear equation that is to be solved with SNES 1014 G(U) = F[t0+Theta*dt, U, (U-U0)*shift] = 0 1015 */ 1016 #undef __FUNCT__ 1017 #define __FUNCT__ "SNESTSFormFunction_ARKIMEX" 1018 static PetscErrorCode SNESTSFormFunction_ARKIMEX(SNES snes,Vec X,Vec F,TS ts) 1019 { 1020 TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data; 1021 DM dm,dmsave; 1022 Vec Z,Ydot; 1023 PetscReal shift = ark->scoeff / ts->time_step; 1024 PetscErrorCode ierr; 1025 1026 PetscFunctionBegin; 1027 ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr); 1028 ierr = TSARKIMEXGetVecs(ts,dm,&Z,&Ydot);CHKERRQ(ierr); 1029 ierr = VecAXPBYPCZ(Ydot,-shift,shift,0,Z,X);CHKERRQ(ierr); /* Ydot = shift*(X-Z) */ 1030 dmsave = ts->dm; 1031 ts->dm = dm; 1032 1033 ierr = TSComputeIFunction(ts,ark->stage_time,X,Ydot,F,ark->imex);CHKERRQ(ierr); 1034 1035 ts->dm = dmsave; 1036 ierr = TSARKIMEXRestoreVecs(ts,dm,&Z,&Ydot);CHKERRQ(ierr); 1037 PetscFunctionReturn(0); 1038 } 1039 1040 #undef __FUNCT__ 1041 #define __FUNCT__ "SNESTSFormJacobian_ARKIMEX" 1042 static PetscErrorCode SNESTSFormJacobian_ARKIMEX(SNES snes,Vec X,Mat *A,Mat *B,MatStructure *str,TS ts) 1043 { 1044 TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data; 1045 DM dm,dmsave; 1046 Vec Ydot; 1047 PetscReal shift = ark->scoeff / ts->time_step; 1048 PetscErrorCode ierr; 1049 1050 PetscFunctionBegin; 1051 ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr); 1052 ierr = TSARKIMEXGetVecs(ts,dm,NULL,&Ydot);CHKERRQ(ierr); 1053 /* ark->Ydot has already been computed in SNESTSFormFunction_ARKIMEX (SNES guarantees this) */ 1054 dmsave = ts->dm; 1055 ts->dm = dm; 1056 1057 ierr = TSComputeIJacobian(ts,ark->stage_time,X,Ydot,shift,A,B,str,ark->imex);CHKERRQ(ierr); 1058 1059 ts->dm = dmsave; 1060 ierr = TSARKIMEXRestoreVecs(ts,dm,NULL,&Ydot);CHKERRQ(ierr); 1061 PetscFunctionReturn(0); 1062 } 1063 1064 #undef __FUNCT__ 1065 #define __FUNCT__ "DMCoarsenHook_TSARKIMEX" 1066 static PetscErrorCode DMCoarsenHook_TSARKIMEX(DM fine,DM coarse,void *ctx) 1067 { 1068 PetscFunctionBegin; 1069 PetscFunctionReturn(0); 1070 } 1071 1072 #undef __FUNCT__ 1073 #define __FUNCT__ "DMRestrictHook_TSARKIMEX" 1074 static PetscErrorCode DMRestrictHook_TSARKIMEX(DM fine,Mat restrct,Vec rscale,Mat inject,DM coarse,void *ctx) 1075 { 1076 TS ts = (TS)ctx; 1077 PetscErrorCode ierr; 1078 Vec Z,Z_c; 1079 1080 PetscFunctionBegin; 1081 ierr = TSARKIMEXGetVecs(ts,fine,&Z,NULL);CHKERRQ(ierr); 1082 ierr = TSARKIMEXGetVecs(ts,coarse,&Z_c,NULL);CHKERRQ(ierr); 1083 ierr = MatRestrict(restrct,Z,Z_c);CHKERRQ(ierr); 1084 ierr = VecPointwiseMult(Z_c,rscale,Z_c);CHKERRQ(ierr); 1085 ierr = TSARKIMEXRestoreVecs(ts,fine,&Z,NULL);CHKERRQ(ierr); 1086 ierr = TSARKIMEXRestoreVecs(ts,coarse,&Z_c,NULL);CHKERRQ(ierr); 1087 PetscFunctionReturn(0); 1088 } 1089 1090 1091 #undef __FUNCT__ 1092 #define __FUNCT__ "DMSubDomainHook_TSARKIMEX" 1093 static PetscErrorCode DMSubDomainHook_TSARKIMEX(DM dm,DM subdm,void *ctx) 1094 { 1095 PetscFunctionBegin; 1096 PetscFunctionReturn(0); 1097 } 1098 1099 #undef __FUNCT__ 1100 #define __FUNCT__ "DMSubDomainRestrictHook_TSARKIMEX" 1101 static PetscErrorCode DMSubDomainRestrictHook_TSARKIMEX(DM dm,VecScatter gscat,VecScatter lscat,DM subdm,void *ctx) 1102 { 1103 TS ts = (TS)ctx; 1104 PetscErrorCode ierr; 1105 Vec Z,Z_c; 1106 1107 PetscFunctionBegin; 1108 ierr = TSARKIMEXGetVecs(ts,dm,&Z,NULL);CHKERRQ(ierr); 1109 ierr = TSARKIMEXGetVecs(ts,subdm,&Z_c,NULL);CHKERRQ(ierr); 1110 1111 ierr = VecScatterBegin(gscat,Z,Z_c,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1112 ierr = VecScatterEnd(gscat,Z,Z_c,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1113 1114 ierr = TSARKIMEXRestoreVecs(ts,dm,&Z,NULL);CHKERRQ(ierr); 1115 ierr = TSARKIMEXRestoreVecs(ts,subdm,&Z_c,NULL);CHKERRQ(ierr); 1116 PetscFunctionReturn(0); 1117 } 1118 1119 #undef __FUNCT__ 1120 #define __FUNCT__ "TSSetUp_ARKIMEX" 1121 static PetscErrorCode TSSetUp_ARKIMEX(TS ts) 1122 { 1123 TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data; 1124 ARKTableau tab; 1125 PetscInt s; 1126 PetscErrorCode ierr; 1127 DM dm; 1128 1129 PetscFunctionBegin; 1130 if (!ark->tableau) { 1131 ierr = TSARKIMEXSetType(ts,TSARKIMEXDefault);CHKERRQ(ierr); 1132 } 1133 tab = ark->tableau; 1134 s = tab->s; 1135 ierr = VecDuplicateVecs(ts->vec_sol,s,&ark->Y);CHKERRQ(ierr); 1136 ierr = VecDuplicateVecs(ts->vec_sol,s,&ark->YdotI);CHKERRQ(ierr); 1137 ierr = VecDuplicateVecs(ts->vec_sol,s,&ark->YdotRHS);CHKERRQ(ierr); 1138 if (ark->init_guess_extrp) { 1139 ierr = VecDuplicateVecs(ts->vec_sol,s,&ark->Y_prev);CHKERRQ(ierr); 1140 ierr = VecDuplicateVecs(ts->vec_sol,s,&ark->YdotI_prev);CHKERRQ(ierr); 1141 ierr = VecDuplicateVecs(ts->vec_sol,s,&ark->YdotRHS_prev);CHKERRQ(ierr); 1142 } 1143 ierr = VecDuplicate(ts->vec_sol,&ark->Ydot);CHKERRQ(ierr); 1144 ierr = VecDuplicate(ts->vec_sol,&ark->Work);CHKERRQ(ierr); 1145 ierr = VecDuplicate(ts->vec_sol,&ark->Ydot0);CHKERRQ(ierr); 1146 ierr = VecDuplicate(ts->vec_sol,&ark->Z);CHKERRQ(ierr); 1147 ierr = PetscMalloc(s*sizeof(ark->work[0]),&ark->work);CHKERRQ(ierr); 1148 ierr = TSGetDM(ts,&dm);CHKERRQ(ierr); 1149 if (dm) { 1150 ierr = DMCoarsenHookAdd(dm,DMCoarsenHook_TSARKIMEX,DMRestrictHook_TSARKIMEX,ts);CHKERRQ(ierr); 1151 ierr = DMSubDomainHookAdd(dm,DMSubDomainHook_TSARKIMEX,DMSubDomainRestrictHook_TSARKIMEX,ts);CHKERRQ(ierr); 1152 } 1153 PetscFunctionReturn(0); 1154 } 1155 /*------------------------------------------------------------*/ 1156 1157 #undef __FUNCT__ 1158 #define __FUNCT__ "TSSetFromOptions_ARKIMEX" 1159 static PetscErrorCode TSSetFromOptions_ARKIMEX(TS ts) 1160 { 1161 TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data; 1162 PetscErrorCode ierr; 1163 char arktype[256]; 1164 1165 PetscFunctionBegin; 1166 ierr = PetscOptionsHead("ARKIMEX ODE solver options");CHKERRQ(ierr); 1167 { 1168 ARKTableauLink link; 1169 PetscInt count,choice; 1170 PetscBool flg; 1171 const char **namelist; 1172 ierr = PetscStrncpy(arktype,TSARKIMEXDefault,sizeof(arktype));CHKERRQ(ierr); 1173 for (link=ARKTableauList,count=0; link; link=link->next,count++) ; 1174 ierr = PetscMalloc(count*sizeof(char*),&namelist);CHKERRQ(ierr); 1175 for (link=ARKTableauList,count=0; link; link=link->next,count++) namelist[count] = link->tab.name; 1176 ierr = PetscOptionsEList("-ts_arkimex_type","Family of ARK IMEX method","TSARKIMEXSetType",(const char*const*)namelist,count,arktype,&choice,&flg);CHKERRQ(ierr); 1177 ierr = TSARKIMEXSetType(ts,flg ? namelist[choice] : arktype);CHKERRQ(ierr); 1178 ierr = PetscFree(namelist);CHKERRQ(ierr); 1179 flg = (PetscBool) !ark->imex; 1180 ierr = PetscOptionsBool("-ts_arkimex_fully_implicit","Solve the problem fully implicitly","TSARKIMEXSetFullyImplicit",flg,&flg,NULL);CHKERRQ(ierr); 1181 ark->imex = (PetscBool) !flg; 1182 ark->init_guess_extrp = PETSC_FALSE; 1183 ierr = PetscOptionsBool("-ts_arkimex_initial_guess_extrapolate","Extrapolate the initial guess for the stage solution from stage values of the previous time step","",ark->init_guess_extrp,&ark->init_guess_extrp,NULL);CHKERRQ(ierr); 1184 ierr = SNESSetFromOptions(ts->snes);CHKERRQ(ierr); 1185 } 1186 ierr = PetscOptionsTail();CHKERRQ(ierr); 1187 PetscFunctionReturn(0); 1188 } 1189 1190 #undef __FUNCT__ 1191 #define __FUNCT__ "PetscFormatRealArray" 1192 static PetscErrorCode PetscFormatRealArray(char buf[],size_t len,const char *fmt,PetscInt n,const PetscReal x[]) 1193 { 1194 PetscErrorCode ierr; 1195 PetscInt i; 1196 size_t left,count; 1197 char *p; 1198 1199 PetscFunctionBegin; 1200 for (i=0,p=buf,left=len; i<n; i++) { 1201 ierr = PetscSNPrintfCount(p,left,fmt,&count,x[i]);CHKERRQ(ierr); 1202 if (count >= left) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Insufficient space in buffer"); 1203 left -= count; 1204 p += count; 1205 *p++ = ' '; 1206 } 1207 p[i ? 0 : -1] = 0; 1208 PetscFunctionReturn(0); 1209 } 1210 1211 #undef __FUNCT__ 1212 #define __FUNCT__ "TSView_ARKIMEX" 1213 static PetscErrorCode TSView_ARKIMEX(TS ts,PetscViewer viewer) 1214 { 1215 TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data; 1216 ARKTableau tab = ark->tableau; 1217 PetscBool iascii; 1218 PetscErrorCode ierr; 1219 TSAdapt adapt; 1220 1221 PetscFunctionBegin; 1222 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr); 1223 if (iascii) { 1224 TSARKIMEXType arktype; 1225 char buf[512]; 1226 ierr = TSARKIMEXGetType(ts,&arktype);CHKERRQ(ierr); 1227 ierr = PetscViewerASCIIPrintf(viewer," ARK IMEX %s\n",arktype);CHKERRQ(ierr); 1228 ierr = PetscFormatRealArray(buf,sizeof(buf),"% 8.6f",tab->s,tab->ct);CHKERRQ(ierr); 1229 ierr = PetscViewerASCIIPrintf(viewer," Stiff abscissa ct = %s\n",buf);CHKERRQ(ierr); 1230 ierr = PetscFormatRealArray(buf,sizeof(buf),"% 8.6f",tab->s,tab->c);CHKERRQ(ierr); 1231 ierr = PetscViewerASCIIPrintf(viewer,"Stiffly accurate: %s\n",tab->stiffly_accurate ? "yes" : "no");CHKERRQ(ierr); 1232 ierr = PetscViewerASCIIPrintf(viewer,"Explicit first stage: %s\n",tab->explicit_first_stage ? "yes" : "no");CHKERRQ(ierr); 1233 ierr = PetscViewerASCIIPrintf(viewer,"FSAL property: %s\n",tab->FSAL_implicit ? "yes" : "no");CHKERRQ(ierr); 1234 ierr = PetscViewerASCIIPrintf(viewer," Nonstiff abscissa c = %s\n",buf);CHKERRQ(ierr); 1235 } 1236 ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr); 1237 ierr = TSAdaptView(adapt,viewer);CHKERRQ(ierr); 1238 ierr = SNESView(ts->snes,viewer);CHKERRQ(ierr); 1239 PetscFunctionReturn(0); 1240 } 1241 1242 #undef __FUNCT__ 1243 #define __FUNCT__ "TSLoad_ARKIMEX" 1244 static PetscErrorCode TSLoad_ARKIMEX(TS ts,PetscViewer viewer) 1245 { 1246 PetscErrorCode ierr; 1247 SNES snes; 1248 TSAdapt tsadapt; 1249 1250 PetscFunctionBegin; 1251 ierr = TSGetAdapt(ts,&tsadapt);CHKERRQ(ierr); 1252 ierr = TSAdaptLoad(tsadapt,viewer);CHKERRQ(ierr); 1253 ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr); 1254 ierr = SNESLoad(snes,viewer);CHKERRQ(ierr); 1255 /* function and Jacobian context for SNES when used with TS is always ts object */ 1256 ierr = SNESSetFunction(snes,NULL,NULL,ts);CHKERRQ(ierr); 1257 ierr = SNESSetJacobian(snes,NULL,NULL,NULL,ts);CHKERRQ(ierr); 1258 PetscFunctionReturn(0); 1259 } 1260 1261 #undef __FUNCT__ 1262 #define __FUNCT__ "TSARKIMEXSetType" 1263 /*@C 1264 TSARKIMEXSetType - Set the type of ARK IMEX scheme 1265 1266 Logically collective 1267 1268 Input Parameter: 1269 + ts - timestepping context 1270 - arktype - type of ARK-IMEX scheme 1271 1272 Level: intermediate 1273 1274 .seealso: TSARKIMEXGetType(), TSARKIMEX, TSARKIMEX2D, TSARKIMEX2E, TSARKIMEXPRSSP2, TSARKIMEX3, TSARKIMEXBPR3, TSARKIMEXARS443, TSARKIMEX4, TSARKIMEX5 1275 @*/ 1276 PetscErrorCode TSARKIMEXSetType(TS ts,TSARKIMEXType arktype) 1277 { 1278 PetscErrorCode ierr; 1279 1280 PetscFunctionBegin; 1281 PetscValidHeaderSpecific(ts,TS_CLASSID,1); 1282 ierr = PetscTryMethod(ts,"TSARKIMEXSetType_C",(TS,TSARKIMEXType),(ts,arktype));CHKERRQ(ierr); 1283 PetscFunctionReturn(0); 1284 } 1285 1286 #undef __FUNCT__ 1287 #define __FUNCT__ "TSARKIMEXGetType" 1288 /*@C 1289 TSARKIMEXGetType - Get the type of ARK IMEX scheme 1290 1291 Logically collective 1292 1293 Input Parameter: 1294 . ts - timestepping context 1295 1296 Output Parameter: 1297 . arktype - type of ARK-IMEX scheme 1298 1299 Level: intermediate 1300 1301 .seealso: TSARKIMEXGetType() 1302 @*/ 1303 PetscErrorCode TSARKIMEXGetType(TS ts,TSARKIMEXType *arktype) 1304 { 1305 PetscErrorCode ierr; 1306 1307 PetscFunctionBegin; 1308 PetscValidHeaderSpecific(ts,TS_CLASSID,1); 1309 ierr = PetscUseMethod(ts,"TSARKIMEXGetType_C",(TS,TSARKIMEXType*),(ts,arktype));CHKERRQ(ierr); 1310 PetscFunctionReturn(0); 1311 } 1312 1313 #undef __FUNCT__ 1314 #define __FUNCT__ "TSARKIMEXSetFullyImplicit" 1315 /*@C 1316 TSARKIMEXSetFullyImplicit - Solve both parts of the equation implicitly 1317 1318 Logically collective 1319 1320 Input Parameter: 1321 + ts - timestepping context 1322 - flg - PETSC_TRUE for fully implicit 1323 1324 Level: intermediate 1325 1326 .seealso: TSARKIMEXGetType() 1327 @*/ 1328 PetscErrorCode TSARKIMEXSetFullyImplicit(TS ts,PetscBool flg) 1329 { 1330 PetscErrorCode ierr; 1331 1332 PetscFunctionBegin; 1333 PetscValidHeaderSpecific(ts,TS_CLASSID,1); 1334 ierr = PetscTryMethod(ts,"TSARKIMEXSetFullyImplicit_C",(TS,PetscBool),(ts,flg));CHKERRQ(ierr); 1335 PetscFunctionReturn(0); 1336 } 1337 1338 #undef __FUNCT__ 1339 #define __FUNCT__ "TSARKIMEXGetType_ARKIMEX" 1340 PetscErrorCode TSARKIMEXGetType_ARKIMEX(TS ts,TSARKIMEXType *arktype) 1341 { 1342 TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data; 1343 PetscErrorCode ierr; 1344 1345 PetscFunctionBegin; 1346 if (!ark->tableau) { 1347 ierr = TSARKIMEXSetType(ts,TSARKIMEXDefault);CHKERRQ(ierr); 1348 } 1349 *arktype = ark->tableau->name; 1350 PetscFunctionReturn(0); 1351 } 1352 #undef __FUNCT__ 1353 #define __FUNCT__ "TSARKIMEXSetType_ARKIMEX" 1354 PetscErrorCode TSARKIMEXSetType_ARKIMEX(TS ts,TSARKIMEXType arktype) 1355 { 1356 TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data; 1357 PetscErrorCode ierr; 1358 PetscBool match; 1359 ARKTableauLink link; 1360 1361 PetscFunctionBegin; 1362 if (ark->tableau) { 1363 ierr = PetscStrcmp(ark->tableau->name,arktype,&match);CHKERRQ(ierr); 1364 if (match) PetscFunctionReturn(0); 1365 } 1366 for (link = ARKTableauList; link; link=link->next) { 1367 ierr = PetscStrcmp(link->tab.name,arktype,&match);CHKERRQ(ierr); 1368 if (match) { 1369 ierr = TSReset_ARKIMEX(ts);CHKERRQ(ierr); 1370 ark->tableau = &link->tab; 1371 PetscFunctionReturn(0); 1372 } 1373 } 1374 SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_ARG_UNKNOWN_TYPE,"Could not find '%s'",arktype); 1375 PetscFunctionReturn(0); 1376 } 1377 #undef __FUNCT__ 1378 #define __FUNCT__ "TSARKIMEXSetFullyImplicit_ARKIMEX" 1379 PetscErrorCode TSARKIMEXSetFullyImplicit_ARKIMEX(TS ts,PetscBool flg) 1380 { 1381 TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data; 1382 1383 PetscFunctionBegin; 1384 ark->imex = (PetscBool)!flg; 1385 PetscFunctionReturn(0); 1386 } 1387 1388 /* ------------------------------------------------------------ */ 1389 /*MC 1390 TSARKIMEX - ODE and DAE solver using Additive Runge-Kutta IMEX schemes 1391 1392 These methods are intended for problems with well-separated time scales, especially when a slow scale is strongly 1393 nonlinear such that it is expensive to solve with a fully implicit method. The user should provide the stiff part 1394 of the equation using TSSetIFunction() and the non-stiff part with TSSetRHSFunction(). 1395 1396 Notes: 1397 The default is TSARKIMEX3, it can be changed with TSARKIMEXSetType() or -ts_arkimex_type 1398 1399 Methods with an explicit stage can only be used with ODE in which the stiff part G(t,X,Xdot) has the form Xdot + Ghat(t,X). 1400 1401 Level: beginner 1402 1403 .seealso: TSCreate(), TS, TSSetType(), TSARKIMEXSetType(), TSARKIMEXGetType(), TSARKIMEXSetFullyImplicit(), TSARKIMEX2D, TTSARKIMEX2E, TSARKIMEX3, 1404 TSARKIMEX4, TSARKIMEX5, TSARKIMEXPRSSP2, TSARKIMEXBPR3, TSARKIMEXType, TSARKIMEXRegister() 1405 1406 M*/ 1407 #undef __FUNCT__ 1408 #define __FUNCT__ "TSCreate_ARKIMEX" 1409 PETSC_EXTERN PetscErrorCode TSCreate_ARKIMEX(TS ts) 1410 { 1411 TS_ARKIMEX *th; 1412 PetscErrorCode ierr; 1413 1414 PetscFunctionBegin; 1415 ierr = TSARKIMEXInitializePackage();CHKERRQ(ierr); 1416 1417 ts->ops->reset = TSReset_ARKIMEX; 1418 ts->ops->destroy = TSDestroy_ARKIMEX; 1419 ts->ops->view = TSView_ARKIMEX; 1420 ts->ops->load = TSLoad_ARKIMEX; 1421 ts->ops->setup = TSSetUp_ARKIMEX; 1422 ts->ops->step = TSStep_ARKIMEX; 1423 ts->ops->interpolate = TSInterpolate_ARKIMEX; 1424 ts->ops->evaluatestep = TSEvaluateStep_ARKIMEX; 1425 ts->ops->setfromoptions = TSSetFromOptions_ARKIMEX; 1426 ts->ops->snesfunction = SNESTSFormFunction_ARKIMEX; 1427 ts->ops->snesjacobian = SNESTSFormJacobian_ARKIMEX; 1428 1429 ierr = PetscNewLog(ts,TS_ARKIMEX,&th);CHKERRQ(ierr); 1430 ts->data = (void*)th; 1431 th->imex = PETSC_TRUE; 1432 1433 ierr = PetscObjectComposeFunction((PetscObject)ts,"TSARKIMEXGetType_C",TSARKIMEXGetType_ARKIMEX);CHKERRQ(ierr); 1434 ierr = PetscObjectComposeFunction((PetscObject)ts,"TSARKIMEXSetType_C",TSARKIMEXSetType_ARKIMEX);CHKERRQ(ierr); 1435 ierr = PetscObjectComposeFunction((PetscObject)ts,"TSARKIMEXSetFullyImplicit_C",TSARKIMEXSetFullyImplicit_ARKIMEX);CHKERRQ(ierr); 1436 PetscFunctionReturn(0); 1437 } 1438