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 = PetscCalloc1(1,&link);CHKERRQ(ierr); 557 t = &link->tab; 558 ierr = PetscStrallocpy(name,&t->name);CHKERRQ(ierr); 559 t->order = order; 560 t->s = s; 561 ierr = PetscMalloc6(s*s,&t->At,s,&t->bt,s,&t->ct,s*s,&t->A,s,&t->b,s,&t->c);CHKERRQ(ierr); 562 ierr = PetscMemcpy(t->At,At,s*s*sizeof(At[0]));CHKERRQ(ierr); 563 ierr = PetscMemcpy(t->A,A,s*s*sizeof(A[0]));CHKERRQ(ierr); 564 if (bt) { ierr = PetscMemcpy(t->bt,bt,s*sizeof(bt[0]));CHKERRQ(ierr); } 565 else for (i=0; i<s; i++) t->bt[i] = At[(s-1)*s+i]; 566 if (b) { ierr = PetscMemcpy(t->b,b,s*sizeof(b[0]));CHKERRQ(ierr); } 567 else for (i=0; i<s; i++) t->b[i] = t->bt[i]; 568 if (ct) { ierr = PetscMemcpy(t->ct,ct,s*sizeof(ct[0]));CHKERRQ(ierr); } 569 else for (i=0; i<s; i++) for (j=0,t->ct[i]=0; j<s; j++) t->ct[i] += At[i*s+j]; 570 if (c) { ierr = PetscMemcpy(t->c,c,s*sizeof(c[0]));CHKERRQ(ierr); } 571 else for (i=0; i<s; i++) for (j=0,t->c[i]=0; j<s; j++) t->c[i] += A[i*s+j]; 572 t->stiffly_accurate = PETSC_TRUE; 573 for (i=0; i<s; i++) if (t->At[(s-1)*s+i] != t->bt[i]) t->stiffly_accurate = PETSC_FALSE; 574 t->explicit_first_stage = PETSC_TRUE; 575 for (i=0; i<s; i++) if (t->At[i] != 0.0) t->explicit_first_stage = PETSC_FALSE; 576 /*def of FSAL can be made more precise*/ 577 t->FSAL_implicit = (PetscBool)(t->explicit_first_stage && t->stiffly_accurate); 578 if (bembedt) { 579 ierr = PetscMalloc2(s,&t->bembedt,s,&t->bembed);CHKERRQ(ierr); 580 ierr = PetscMemcpy(t->bembedt,bembedt,s*sizeof(bembedt[0]));CHKERRQ(ierr); 581 ierr = PetscMemcpy(t->bembed,bembed ? bembed : bembedt,s*sizeof(bembed[0]));CHKERRQ(ierr); 582 } 583 584 t->pinterp = pinterp; 585 ierr = PetscMalloc2(s*pinterp,&t->binterpt,s*pinterp,&t->binterp);CHKERRQ(ierr); 586 ierr = PetscMemcpy(t->binterpt,binterpt,s*pinterp*sizeof(binterpt[0]));CHKERRQ(ierr); 587 ierr = PetscMemcpy(t->binterp,binterp ? binterp : binterpt,s*pinterp*sizeof(binterpt[0]));CHKERRQ(ierr); 588 link->next = ARKTableauList; 589 ARKTableauList = link; 590 PetscFunctionReturn(0); 591 } 592 593 #undef __FUNCT__ 594 #define __FUNCT__ "TSEvaluateStep_ARKIMEX" 595 /* 596 The step completion formula is 597 598 x1 = x0 - h bt^T YdotI + h b^T YdotRHS 599 600 This function can be called before or after ts->vec_sol has been updated. 601 Suppose we have a completion formula (bt,b) and an embedded formula (bet,be) of different order. 602 We can write 603 604 x1e = x0 - h bet^T YdotI + h be^T YdotRHS 605 = x1 + h bt^T YdotI - h b^T YdotRHS - h bet^T YdotI + h be^T YdotRHS 606 = x1 - h (bet - bt)^T YdotI + h (be - b)^T YdotRHS 607 608 so we can evaluate the method with different order even after the step has been optimistically completed. 609 */ 610 static PetscErrorCode TSEvaluateStep_ARKIMEX(TS ts,PetscInt order,Vec X,PetscBool *done) 611 { 612 TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data; 613 ARKTableau tab = ark->tableau; 614 PetscScalar *w = ark->work; 615 PetscReal h; 616 PetscInt s = tab->s,j; 617 PetscErrorCode ierr; 618 619 PetscFunctionBegin; 620 switch (ark->status) { 621 case TS_STEP_INCOMPLETE: 622 case TS_STEP_PENDING: 623 h = ts->time_step; break; 624 case TS_STEP_COMPLETE: 625 h = ts->time_step_prev; break; 626 default: SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_PLIB,"Invalid TSStepStatus"); 627 } 628 if (order == tab->order) { 629 if (ark->status == TS_STEP_INCOMPLETE) { 630 if (!ark->imex && tab->stiffly_accurate) { /* Only the stiffly accurate implicit formula is used */ 631 ierr = VecCopy(ark->Y[s-1],X);CHKERRQ(ierr); 632 } else { /* Use the standard completion formula (bt,b) */ 633 ierr = VecCopy(ts->vec_sol,X);CHKERRQ(ierr); 634 for (j=0; j<s; j++) w[j] = h*tab->bt[j]; 635 ierr = VecMAXPY(X,s,w,ark->YdotI);CHKERRQ(ierr); 636 if (ark->imex) { /* Method is IMEX, complete the explicit formula */ 637 for (j=0; j<s; j++) w[j] = h*tab->b[j]; 638 ierr = VecMAXPY(X,s,w,ark->YdotRHS);CHKERRQ(ierr); 639 } 640 } 641 } else {ierr = VecCopy(ts->vec_sol,X);CHKERRQ(ierr);} 642 if (done) *done = PETSC_TRUE; 643 PetscFunctionReturn(0); 644 } else if (order == tab->order-1) { 645 if (!tab->bembedt) goto unavailable; 646 if (ark->status == TS_STEP_INCOMPLETE) { /* Complete with the embedded method (bet,be) */ 647 ierr = VecCopy(ts->vec_sol,X);CHKERRQ(ierr); 648 for (j=0; j<s; j++) w[j] = h*tab->bembedt[j]; 649 ierr = VecMAXPY(X,s,w,ark->YdotI);CHKERRQ(ierr); 650 for (j=0; j<s; j++) w[j] = h*tab->bembed[j]; 651 ierr = VecMAXPY(X,s,w,ark->YdotRHS);CHKERRQ(ierr); 652 } else { /* Rollback and re-complete using (bet-be,be-b) */ 653 ierr = VecCopy(ts->vec_sol,X);CHKERRQ(ierr); 654 for (j=0; j<s; j++) w[j] = h*(tab->bembedt[j] - tab->bt[j]); 655 ierr = VecMAXPY(X,tab->s,w,ark->YdotI);CHKERRQ(ierr); 656 for (j=0; j<s; j++) w[j] = h*(tab->bembed[j] - tab->b[j]); 657 ierr = VecMAXPY(X,s,w,ark->YdotRHS);CHKERRQ(ierr); 658 } 659 if (done) *done = PETSC_TRUE; 660 PetscFunctionReturn(0); 661 } 662 unavailable: 663 if (done) *done = PETSC_FALSE; 664 else SETERRQ3(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"ARKIMEX '%s' of order %D cannot evaluate step at order %D",tab->name,tab->order,order); 665 PetscFunctionReturn(0); 666 } 667 668 #undef __FUNCT__ 669 #define __FUNCT__ "TSStep_ARKIMEX" 670 static PetscErrorCode TSStep_ARKIMEX(TS ts) 671 { 672 TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data; 673 ARKTableau tab = ark->tableau; 674 const PetscInt s = tab->s; 675 const PetscReal *At = tab->At,*A = tab->A,*bt = tab->bt,*b = tab->b,*ct = tab->ct,*c = tab->c; 676 PetscScalar *w = ark->work; 677 Vec *Y = ark->Y,*YdotI = ark->YdotI,*YdotRHS = ark->YdotRHS,Ydot = ark->Ydot,Ydot0 = ark->Ydot0,W = ark->Work,Z = ark->Z; 678 PetscBool init_guess_extrp = ark->init_guess_extrp; 679 TSAdapt adapt; 680 SNES snes; 681 PetscInt i,j,its,lits,reject,next_scheme; 682 PetscReal next_time_step; 683 PetscReal t; 684 PetscBool accept; 685 PetscErrorCode ierr; 686 687 PetscFunctionBegin; 688 if (ts->equation_type >= TS_EQ_IMPLICIT && tab->explicit_first_stage) { 689 PetscReal valid_time; 690 PetscBool isvalid; 691 ierr = PetscObjectComposedDataGetReal((PetscObject)ts->vec_sol, 692 explicit_stage_time_id, 693 valid_time, 694 isvalid); 695 CHKERRQ(ierr); 696 if (!isvalid || valid_time != ts->ptime) { 697 TS ts_start; 698 SNES snes_start; 699 DM dm; 700 PetscReal atol; 701 Vec vatol; 702 PetscReal rtol; 703 Vec vrtol; 704 705 ierr = TSCreate(PetscObjectComm((PetscObject)ts),&ts_start);CHKERRQ(ierr); 706 ierr = TSGetSNES(ts,&snes_start);CHKERRQ(ierr); 707 ierr = TSSetSNES(ts_start,snes_start);CHKERRQ(ierr); 708 ierr = TSGetDM(ts,&dm);CHKERRQ(ierr); 709 ierr = TSSetDM(ts_start,dm);CHKERRQ(ierr); 710 711 ts_start->adapt=ts->adapt; 712 PetscObjectReference((PetscObject)ts_start->adapt); 713 714 ierr = TSSetSolution(ts_start,ts->vec_sol);CHKERRQ(ierr); 715 ierr = TSSetTime(ts_start,ts->ptime);CHKERRQ(ierr); 716 ierr = TSSetDuration(ts_start,1,ts->ptime+ts->time_step);CHKERRQ(ierr); 717 ierr = TSSetTimeStep(ts_start,ts->time_step);CHKERRQ(ierr); 718 ierr = TSSetType(ts_start,TSARKIMEX);CHKERRQ(ierr); 719 ierr = TSARKIMEXSetFullyImplicit(ts_start,PETSC_TRUE);CHKERRQ(ierr); 720 ierr = TSARKIMEXSetType(ts_start,TSARKIMEX1BEE);CHKERRQ(ierr); 721 ierr = TSSetEquationType(ts_start,ts->equation_type);CHKERRQ(ierr); 722 ierr = TSGetTolerances(ts,&atol,&vatol,&rtol,&vrtol);CHKERRQ(ierr); 723 ierr = TSSetTolerances(ts_start,atol,vatol,rtol,vrtol);CHKERRQ(ierr); 724 ierr = TSSolve(ts_start,ts->vec_sol);CHKERRQ(ierr); 725 ierr = TSGetTime(ts_start,&ts->ptime);CHKERRQ(ierr); 726 727 ts->time_step = ts_start->time_step; 728 ts->steps++; 729 ierr = VecCopy(((TS_ARKIMEX*)ts_start->data)->Ydot0,Ydot0);CHKERRQ(ierr); 730 ts_start->snes=NULL; 731 ierr = TSSetSNES(ts,snes_start);CHKERRQ(ierr); 732 ierr = SNESDestroy(&snes_start);CHKERRQ(ierr); 733 ierr = TSDestroy(&ts_start);CHKERRQ(ierr); 734 } 735 } 736 737 ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr); 738 next_time_step = ts->time_step; 739 t = ts->ptime; 740 accept = PETSC_TRUE; 741 ark->status = TS_STEP_INCOMPLETE; 742 743 744 for (reject=0; reject<ts->max_reject && !ts->reason; reject++,ts->reject++) { 745 PetscReal h = ts->time_step; 746 ierr = TSPreStep(ts);CHKERRQ(ierr); 747 for (i=0; i<s; i++) { 748 ark->stage_time = t + h*ct[i]; 749 if (At[i*s+i] == 0) { /* This stage is explicit */ 750 ierr = VecCopy(ts->vec_sol,Y[i]);CHKERRQ(ierr); 751 for (j=0; j<i; j++) w[j] = h*At[i*s+j]; 752 ierr = VecMAXPY(Y[i],i,w,YdotI);CHKERRQ(ierr); 753 for (j=0; j<i; j++) w[j] = h*A[i*s+j]; 754 ierr = VecMAXPY(Y[i],i,w,YdotRHS);CHKERRQ(ierr); 755 } else { 756 ark->scoeff = 1./At[i*s+i]; 757 ierr = TSPreStage(ts,ark->stage_time);CHKERRQ(ierr); 758 /* Affine part */ 759 ierr = VecZeroEntries(W);CHKERRQ(ierr); 760 for (j=0; j<i; j++) w[j] = h*A[i*s+j]; 761 ierr = VecMAXPY(W,i,w,YdotRHS);CHKERRQ(ierr); 762 ierr = VecScale(W, ark->scoeff/h);CHKERRQ(ierr); 763 764 /* Ydot = shift*(Y-Z) */ 765 ierr = VecCopy(ts->vec_sol,Z);CHKERRQ(ierr); 766 for (j=0; j<i; j++) w[j] = h*At[i*s+j]; 767 ierr = VecMAXPY(Z,i,w,YdotI);CHKERRQ(ierr); 768 769 if (init_guess_extrp && ark->prev_step_valid) { 770 /* Initial guess extrapolated from previous time step stage values */ 771 ierr = TSExtrapolate_ARKIMEX(ts,c[i],Y[i]);CHKERRQ(ierr); 772 } else { 773 /* Initial guess taken from last stage */ 774 ierr = VecCopy(i>0 ? Y[i-1] : ts->vec_sol,Y[i]);CHKERRQ(ierr); 775 } 776 ierr = SNESSolve(snes,W,Y[i]);CHKERRQ(ierr); 777 ierr = (ts->ops->snesfunction)(snes,Y[i],W,ts);CHKERRQ(ierr); 778 ierr = SNESGetIterationNumber(snes,&its);CHKERRQ(ierr); 779 ierr = SNESGetLinearSolveIterations(snes,&lits);CHKERRQ(ierr); 780 ts->snes_its += its; ts->ksp_its += lits; 781 ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr); 782 ierr = TSAdaptCheckStage(adapt,ts,&accept);CHKERRQ(ierr); 783 if (!accept) { 784 /* We are likely rejecting the step because of solver or function domain problems so we should not attempt to 785 * use extrapolation to initialize the solves on the next attempt. */ 786 ark->prev_step_valid = PETSC_FALSE; 787 goto reject_step; 788 } 789 } 790 ierr = TSPostStage(ts,ark->stage_time,i,Y); CHKERRQ(ierr); 791 if (ts->equation_type>=TS_EQ_IMPLICIT) { 792 if (i==0 && tab->explicit_first_stage) { 793 ierr = VecCopy(Ydot0,YdotI[0]);CHKERRQ(ierr); 794 } else { 795 ierr = VecAXPBYPCZ(YdotI[i],-ark->scoeff/h,ark->scoeff/h,0,Z,Y[i]);CHKERRQ(ierr); /* Ydot = shift*(X-Z) */ 796 } 797 } else { 798 ierr = VecZeroEntries(Ydot);CHKERRQ(ierr); 799 ierr = TSComputeIFunction(ts,t+h*ct[i],Y[i],Ydot,YdotI[i],ark->imex);CHKERRQ(ierr); 800 ierr = VecScale(YdotI[i], -1.0);CHKERRQ(ierr); 801 if (ark->imex) { 802 ierr = TSComputeRHSFunction(ts,t+h*c[i],Y[i],YdotRHS[i]);CHKERRQ(ierr); 803 } else { 804 ierr = VecZeroEntries(YdotRHS[i]);CHKERRQ(ierr); 805 } 806 } 807 } 808 ierr = TSEvaluateStep(ts,tab->order,ts->vec_sol,NULL);CHKERRQ(ierr); 809 ark->status = TS_STEP_PENDING; 810 811 /* Register only the current method as a candidate because we're not supporting multiple candidates yet. */ 812 ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr); 813 ierr = TSAdaptCandidatesClear(adapt);CHKERRQ(ierr); 814 ierr = TSAdaptCandidateAdd(adapt,tab->name,tab->order,1,tab->ccfl,1.*tab->s,PETSC_TRUE);CHKERRQ(ierr); 815 ierr = TSAdaptChoose(adapt,ts,ts->time_step,&next_scheme,&next_time_step,&accept);CHKERRQ(ierr); 816 if (accept) { 817 /* ignore next_scheme for now */ 818 ts->ptime += ts->time_step; 819 ts->time_step = next_time_step; 820 ts->steps++; 821 if (ts->equation_type>=TS_EQ_IMPLICIT) { /* save the initial slope for the next step*/ 822 ierr = VecCopy(YdotI[s-1],Ydot0);CHKERRQ(ierr); 823 } 824 ark->status = TS_STEP_COMPLETE; 825 if (tab->explicit_first_stage) { 826 ierr = PetscObjectComposedDataSetReal((PetscObject)ts->vec_sol,explicit_stage_time_id,ts->ptime);CHKERRQ(ierr); 827 } 828 /* Save the Y, YdotI, YdotRHS for extrapolation initial guess */ 829 if (ark->init_guess_extrp) { 830 for (i = 0; i<s; i++) { 831 ierr = VecCopy(Y[i],ark->Y_prev[i]);CHKERRQ(ierr); 832 ierr = VecCopy(YdotRHS[i],ark->YdotRHS_prev[i]);CHKERRQ(ierr); 833 ierr = VecCopy(YdotI[i],ark->YdotI_prev[i]);CHKERRQ(ierr); 834 } 835 ark->prev_step_valid = PETSC_TRUE; 836 } 837 break; 838 } else { /* Roll back the current step */ 839 for (j=0; j<s; j++) w[j] = -h*bt[j]; 840 ierr = VecMAXPY(ts->vec_sol,s,w,ark->YdotI);CHKERRQ(ierr); 841 for (j=0; j<s; j++) w[j] = -h*b[j]; 842 ierr = VecMAXPY(ts->vec_sol,s,w,ark->YdotRHS);CHKERRQ(ierr); 843 ts->time_step = next_time_step; 844 ark->status = TS_STEP_INCOMPLETE; 845 } 846 reject_step: continue; 847 } 848 if (ark->status != TS_STEP_COMPLETE && !ts->reason) ts->reason = TS_DIVERGED_STEP_REJECTED; 849 PetscFunctionReturn(0); 850 } 851 852 #undef __FUNCT__ 853 #define __FUNCT__ "TSInterpolate_ARKIMEX" 854 static PetscErrorCode TSInterpolate_ARKIMEX(TS ts,PetscReal itime,Vec X) 855 { 856 TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data; 857 PetscInt s = ark->tableau->s,pinterp = ark->tableau->pinterp,i,j; 858 PetscReal h; 859 PetscReal tt,t; 860 PetscScalar *bt,*b; 861 const PetscReal *Bt = ark->tableau->binterpt,*B = ark->tableau->binterp; 862 PetscErrorCode ierr; 863 864 PetscFunctionBegin; 865 if (!Bt || !B) SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"TSARKIMEX %s does not have an interpolation formula",ark->tableau->name); 866 switch (ark->status) { 867 case TS_STEP_INCOMPLETE: 868 case TS_STEP_PENDING: 869 h = ts->time_step; 870 t = (itime - ts->ptime)/h; 871 break; 872 case TS_STEP_COMPLETE: 873 h = ts->time_step_prev; 874 t = (itime - ts->ptime)/h + 1; /* In the interval [0,1] */ 875 break; 876 default: SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_PLIB,"Invalid TSStepStatus"); 877 } 878 ierr = PetscMalloc2(s,&bt,s,&b);CHKERRQ(ierr); 879 for (i=0; i<s; i++) bt[i] = b[i] = 0; 880 for (j=0,tt=t; j<pinterp; j++,tt*=t) { 881 for (i=0; i<s; i++) { 882 bt[i] += h * Bt[i*pinterp+j] * tt; 883 b[i] += h * B[i*pinterp+j] * tt; 884 } 885 } 886 ierr = VecCopy(ark->Y[0],X);CHKERRQ(ierr); 887 ierr = VecMAXPY(X,s,bt,ark->YdotI);CHKERRQ(ierr); 888 ierr = VecMAXPY(X,s,b,ark->YdotRHS);CHKERRQ(ierr); 889 ierr = PetscFree2(bt,b);CHKERRQ(ierr); 890 PetscFunctionReturn(0); 891 } 892 893 #undef __FUNCT__ 894 #define __FUNCT__ "TSExtrapolate_ARKIMEX" 895 static PetscErrorCode TSExtrapolate_ARKIMEX(TS ts,PetscReal c,Vec X) 896 { 897 TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data; 898 PetscInt s = ark->tableau->s,pinterp = ark->tableau->pinterp,i,j; 899 PetscReal h; 900 PetscReal tt,t; 901 PetscScalar *bt,*b; 902 const PetscReal *Bt = ark->tableau->binterpt,*B = ark->tableau->binterp; 903 PetscErrorCode ierr; 904 905 PetscFunctionBegin; 906 if (!Bt || !B) SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"TSARKIMEX %s does not have an interpolation formula",ark->tableau->name); 907 t = 1.0 + (ts->time_step/ts->time_step_prev)*c; 908 h = ts->time_step; 909 ierr = PetscMalloc2(s,&bt,s,&b);CHKERRQ(ierr); 910 for (i=0; i<s; i++) bt[i] = b[i] = 0; 911 for (j=0,tt=t; j<pinterp; j++,tt*=t) { 912 for (i=0; i<s; i++) { 913 bt[i] += h * Bt[i*pinterp+j] * tt; 914 b[i] += h * B[i*pinterp+j] * tt; 915 } 916 } 917 if (!ark->prev_step_valid) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_SUP,"Stages from previous step have not been stored"); 918 ierr = VecCopy(ark->Y_prev[0],X);CHKERRQ(ierr); 919 ierr = VecMAXPY(X,s,bt,ark->YdotI_prev);CHKERRQ(ierr); 920 ierr = VecMAXPY(X,s,b,ark->YdotRHS_prev);CHKERRQ(ierr); 921 ierr = PetscFree2(bt,b);CHKERRQ(ierr); 922 PetscFunctionReturn(0); 923 } 924 925 /*------------------------------------------------------------*/ 926 #undef __FUNCT__ 927 #define __FUNCT__ "TSReset_ARKIMEX" 928 static PetscErrorCode TSReset_ARKIMEX(TS ts) 929 { 930 TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data; 931 PetscInt s; 932 PetscErrorCode ierr; 933 934 PetscFunctionBegin; 935 if (!ark->tableau) PetscFunctionReturn(0); 936 s = ark->tableau->s; 937 ierr = VecDestroyVecs(s,&ark->Y);CHKERRQ(ierr); 938 ierr = VecDestroyVecs(s,&ark->YdotI);CHKERRQ(ierr); 939 ierr = VecDestroyVecs(s,&ark->YdotRHS);CHKERRQ(ierr); 940 if (&ark->init_guess_extrp) { 941 ierr = VecDestroyVecs(s,&ark->Y_prev);CHKERRQ(ierr); 942 ierr = VecDestroyVecs(s,&ark->YdotI_prev);CHKERRQ(ierr); 943 ierr = VecDestroyVecs(s,&ark->YdotRHS_prev);CHKERRQ(ierr); 944 } 945 ierr = VecDestroy(&ark->Ydot);CHKERRQ(ierr); 946 ierr = VecDestroy(&ark->Work);CHKERRQ(ierr); 947 ierr = VecDestroy(&ark->Ydot0);CHKERRQ(ierr); 948 ierr = VecDestroy(&ark->Z);CHKERRQ(ierr); 949 ierr = PetscFree(ark->work);CHKERRQ(ierr); 950 PetscFunctionReturn(0); 951 } 952 953 #undef __FUNCT__ 954 #define __FUNCT__ "TSDestroy_ARKIMEX" 955 static PetscErrorCode TSDestroy_ARKIMEX(TS ts) 956 { 957 PetscErrorCode ierr; 958 959 PetscFunctionBegin; 960 ierr = TSReset_ARKIMEX(ts);CHKERRQ(ierr); 961 ierr = PetscFree(ts->data);CHKERRQ(ierr); 962 ierr = PetscObjectComposeFunction((PetscObject)ts,"TSARKIMEXGetType_C",NULL);CHKERRQ(ierr); 963 ierr = PetscObjectComposeFunction((PetscObject)ts,"TSARKIMEXSetType_C",NULL);CHKERRQ(ierr); 964 ierr = PetscObjectComposeFunction((PetscObject)ts,"TSARKIMEXSetFullyImplicit_C",NULL);CHKERRQ(ierr); 965 PetscFunctionReturn(0); 966 } 967 968 969 #undef __FUNCT__ 970 #define __FUNCT__ "TSARKIMEXGetVecs" 971 static PetscErrorCode TSARKIMEXGetVecs(TS ts,DM dm,Vec *Z,Vec *Ydot) 972 { 973 TS_ARKIMEX *ax = (TS_ARKIMEX*)ts->data; 974 PetscErrorCode ierr; 975 976 PetscFunctionBegin; 977 if (Z) { 978 if (dm && dm != ts->dm) { 979 ierr = DMGetNamedGlobalVector(dm,"TSARKIMEX_Z",Z);CHKERRQ(ierr); 980 } else *Z = ax->Z; 981 } 982 if (Ydot) { 983 if (dm && dm != ts->dm) { 984 ierr = DMGetNamedGlobalVector(dm,"TSARKIMEX_Ydot",Ydot);CHKERRQ(ierr); 985 } else *Ydot = ax->Ydot; 986 } 987 PetscFunctionReturn(0); 988 } 989 990 991 #undef __FUNCT__ 992 #define __FUNCT__ "TSARKIMEXRestoreVecs" 993 static PetscErrorCode TSARKIMEXRestoreVecs(TS ts,DM dm,Vec *Z,Vec *Ydot) 994 { 995 PetscErrorCode ierr; 996 997 PetscFunctionBegin; 998 if (Z) { 999 if (dm && dm != ts->dm) { 1000 ierr = DMRestoreNamedGlobalVector(dm,"TSARKIMEX_Z",Z);CHKERRQ(ierr); 1001 } 1002 } 1003 if (Ydot) { 1004 if (dm && dm != ts->dm) { 1005 ierr = DMRestoreNamedGlobalVector(dm,"TSARKIMEX_Ydot",Ydot);CHKERRQ(ierr); 1006 } 1007 } 1008 PetscFunctionReturn(0); 1009 } 1010 1011 /* 1012 This defines the nonlinear equation that is to be solved with SNES 1013 G(U) = F[t0+Theta*dt, U, (U-U0)*shift] = 0 1014 */ 1015 #undef __FUNCT__ 1016 #define __FUNCT__ "SNESTSFormFunction_ARKIMEX" 1017 static PetscErrorCode SNESTSFormFunction_ARKIMEX(SNES snes,Vec X,Vec F,TS ts) 1018 { 1019 TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data; 1020 DM dm,dmsave; 1021 Vec Z,Ydot; 1022 PetscReal shift = ark->scoeff / ts->time_step; 1023 PetscErrorCode ierr; 1024 1025 PetscFunctionBegin; 1026 ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr); 1027 ierr = TSARKIMEXGetVecs(ts,dm,&Z,&Ydot);CHKERRQ(ierr); 1028 ierr = VecAXPBYPCZ(Ydot,-shift,shift,0,Z,X);CHKERRQ(ierr); /* Ydot = shift*(X-Z) */ 1029 dmsave = ts->dm; 1030 ts->dm = dm; 1031 1032 ierr = TSComputeIFunction(ts,ark->stage_time,X,Ydot,F,ark->imex);CHKERRQ(ierr); 1033 1034 ts->dm = dmsave; 1035 ierr = TSARKIMEXRestoreVecs(ts,dm,&Z,&Ydot);CHKERRQ(ierr); 1036 PetscFunctionReturn(0); 1037 } 1038 1039 #undef __FUNCT__ 1040 #define __FUNCT__ "SNESTSFormJacobian_ARKIMEX" 1041 static PetscErrorCode SNESTSFormJacobian_ARKIMEX(SNES snes,Vec X,Mat A,Mat B,TS ts) 1042 { 1043 TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data; 1044 DM dm,dmsave; 1045 Vec Ydot; 1046 PetscReal shift = ark->scoeff / ts->time_step; 1047 PetscErrorCode ierr; 1048 1049 PetscFunctionBegin; 1050 ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr); 1051 ierr = TSARKIMEXGetVecs(ts,dm,NULL,&Ydot);CHKERRQ(ierr); 1052 /* ark->Ydot has already been computed in SNESTSFormFunction_ARKIMEX (SNES guarantees this) */ 1053 dmsave = ts->dm; 1054 ts->dm = dm; 1055 1056 ierr = TSComputeIJacobian(ts,ark->stage_time,X,Ydot,shift,A,B,ark->imex);CHKERRQ(ierr); 1057 1058 ts->dm = dmsave; 1059 ierr = TSARKIMEXRestoreVecs(ts,dm,NULL,&Ydot);CHKERRQ(ierr); 1060 PetscFunctionReturn(0); 1061 } 1062 1063 #undef __FUNCT__ 1064 #define __FUNCT__ "DMCoarsenHook_TSARKIMEX" 1065 static PetscErrorCode DMCoarsenHook_TSARKIMEX(DM fine,DM coarse,void *ctx) 1066 { 1067 PetscFunctionBegin; 1068 PetscFunctionReturn(0); 1069 } 1070 1071 #undef __FUNCT__ 1072 #define __FUNCT__ "DMRestrictHook_TSARKIMEX" 1073 static PetscErrorCode DMRestrictHook_TSARKIMEX(DM fine,Mat restrct,Vec rscale,Mat inject,DM coarse,void *ctx) 1074 { 1075 TS ts = (TS)ctx; 1076 PetscErrorCode ierr; 1077 Vec Z,Z_c; 1078 1079 PetscFunctionBegin; 1080 ierr = TSARKIMEXGetVecs(ts,fine,&Z,NULL);CHKERRQ(ierr); 1081 ierr = TSARKIMEXGetVecs(ts,coarse,&Z_c,NULL);CHKERRQ(ierr); 1082 ierr = MatRestrict(restrct,Z,Z_c);CHKERRQ(ierr); 1083 ierr = VecPointwiseMult(Z_c,rscale,Z_c);CHKERRQ(ierr); 1084 ierr = TSARKIMEXRestoreVecs(ts,fine,&Z,NULL);CHKERRQ(ierr); 1085 ierr = TSARKIMEXRestoreVecs(ts,coarse,&Z_c,NULL);CHKERRQ(ierr); 1086 PetscFunctionReturn(0); 1087 } 1088 1089 1090 #undef __FUNCT__ 1091 #define __FUNCT__ "DMSubDomainHook_TSARKIMEX" 1092 static PetscErrorCode DMSubDomainHook_TSARKIMEX(DM dm,DM subdm,void *ctx) 1093 { 1094 PetscFunctionBegin; 1095 PetscFunctionReturn(0); 1096 } 1097 1098 #undef __FUNCT__ 1099 #define __FUNCT__ "DMSubDomainRestrictHook_TSARKIMEX" 1100 static PetscErrorCode DMSubDomainRestrictHook_TSARKIMEX(DM dm,VecScatter gscat,VecScatter lscat,DM subdm,void *ctx) 1101 { 1102 TS ts = (TS)ctx; 1103 PetscErrorCode ierr; 1104 Vec Z,Z_c; 1105 1106 PetscFunctionBegin; 1107 ierr = TSARKIMEXGetVecs(ts,dm,&Z,NULL);CHKERRQ(ierr); 1108 ierr = TSARKIMEXGetVecs(ts,subdm,&Z_c,NULL);CHKERRQ(ierr); 1109 1110 ierr = VecScatterBegin(gscat,Z,Z_c,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1111 ierr = VecScatterEnd(gscat,Z,Z_c,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr); 1112 1113 ierr = TSARKIMEXRestoreVecs(ts,dm,&Z,NULL);CHKERRQ(ierr); 1114 ierr = TSARKIMEXRestoreVecs(ts,subdm,&Z_c,NULL);CHKERRQ(ierr); 1115 PetscFunctionReturn(0); 1116 } 1117 1118 #undef __FUNCT__ 1119 #define __FUNCT__ "TSSetUp_ARKIMEX" 1120 static PetscErrorCode TSSetUp_ARKIMEX(TS ts) 1121 { 1122 TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data; 1123 ARKTableau tab; 1124 PetscInt s; 1125 PetscErrorCode ierr; 1126 DM dm; 1127 1128 PetscFunctionBegin; 1129 if (!ark->tableau) { 1130 ierr = TSARKIMEXSetType(ts,TSARKIMEXDefault);CHKERRQ(ierr); 1131 } 1132 tab = ark->tableau; 1133 s = tab->s; 1134 ierr = VecDuplicateVecs(ts->vec_sol,s,&ark->Y);CHKERRQ(ierr); 1135 ierr = VecDuplicateVecs(ts->vec_sol,s,&ark->YdotI);CHKERRQ(ierr); 1136 ierr = VecDuplicateVecs(ts->vec_sol,s,&ark->YdotRHS);CHKERRQ(ierr); 1137 if (ark->init_guess_extrp) { 1138 ierr = VecDuplicateVecs(ts->vec_sol,s,&ark->Y_prev);CHKERRQ(ierr); 1139 ierr = VecDuplicateVecs(ts->vec_sol,s,&ark->YdotI_prev);CHKERRQ(ierr); 1140 ierr = VecDuplicateVecs(ts->vec_sol,s,&ark->YdotRHS_prev);CHKERRQ(ierr); 1141 } 1142 ierr = VecDuplicate(ts->vec_sol,&ark->Ydot);CHKERRQ(ierr); 1143 ierr = VecDuplicate(ts->vec_sol,&ark->Work);CHKERRQ(ierr); 1144 ierr = VecDuplicate(ts->vec_sol,&ark->Ydot0);CHKERRQ(ierr); 1145 ierr = VecDuplicate(ts->vec_sol,&ark->Z);CHKERRQ(ierr); 1146 ierr = PetscMalloc1(s,&ark->work);CHKERRQ(ierr); 1147 ierr = TSGetDM(ts,&dm);CHKERRQ(ierr); 1148 if (dm) { 1149 ierr = DMCoarsenHookAdd(dm,DMCoarsenHook_TSARKIMEX,DMRestrictHook_TSARKIMEX,ts);CHKERRQ(ierr); 1150 ierr = DMSubDomainHookAdd(dm,DMSubDomainHook_TSARKIMEX,DMSubDomainRestrictHook_TSARKIMEX,ts);CHKERRQ(ierr); 1151 } 1152 PetscFunctionReturn(0); 1153 } 1154 /*------------------------------------------------------------*/ 1155 1156 #undef __FUNCT__ 1157 #define __FUNCT__ "TSSetFromOptions_ARKIMEX" 1158 static PetscErrorCode TSSetFromOptions_ARKIMEX(TS ts) 1159 { 1160 TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data; 1161 PetscErrorCode ierr; 1162 char arktype[256]; 1163 1164 PetscFunctionBegin; 1165 ierr = PetscOptionsHead("ARKIMEX ODE solver options");CHKERRQ(ierr); 1166 { 1167 ARKTableauLink link; 1168 PetscInt count,choice; 1169 PetscBool flg; 1170 const char **namelist; 1171 ierr = PetscStrncpy(arktype,TSARKIMEXDefault,sizeof(arktype));CHKERRQ(ierr); 1172 for (link=ARKTableauList,count=0; link; link=link->next,count++) ; 1173 ierr = PetscMalloc1(count,&namelist);CHKERRQ(ierr); 1174 for (link=ARKTableauList,count=0; link; link=link->next,count++) namelist[count] = link->tab.name; 1175 ierr = PetscOptionsEList("-ts_arkimex_type","Family of ARK IMEX method","TSARKIMEXSetType",(const char*const*)namelist,count,arktype,&choice,&flg);CHKERRQ(ierr); 1176 ierr = TSARKIMEXSetType(ts,flg ? namelist[choice] : arktype);CHKERRQ(ierr); 1177 ierr = PetscFree(namelist);CHKERRQ(ierr); 1178 flg = (PetscBool) !ark->imex; 1179 ierr = PetscOptionsBool("-ts_arkimex_fully_implicit","Solve the problem fully implicitly","TSARKIMEXSetFullyImplicit",flg,&flg,NULL);CHKERRQ(ierr); 1180 ark->imex = (PetscBool) !flg; 1181 ark->init_guess_extrp = PETSC_FALSE; 1182 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); 1183 ierr = SNESSetFromOptions(ts->snes);CHKERRQ(ierr); 1184 } 1185 ierr = PetscOptionsTail();CHKERRQ(ierr); 1186 PetscFunctionReturn(0); 1187 } 1188 1189 #undef __FUNCT__ 1190 #define __FUNCT__ "PetscFormatRealArray" 1191 static PetscErrorCode PetscFormatRealArray(char buf[],size_t len,const char *fmt,PetscInt n,const PetscReal x[]) 1192 { 1193 PetscErrorCode ierr; 1194 PetscInt i; 1195 size_t left,count; 1196 char *p; 1197 1198 PetscFunctionBegin; 1199 for (i=0,p=buf,left=len; i<n; i++) { 1200 ierr = PetscSNPrintfCount(p,left,fmt,&count,x[i]);CHKERRQ(ierr); 1201 if (count >= left) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Insufficient space in buffer"); 1202 left -= count; 1203 p += count; 1204 *p++ = ' '; 1205 } 1206 p[i ? 0 : -1] = 0; 1207 PetscFunctionReturn(0); 1208 } 1209 1210 #undef __FUNCT__ 1211 #define __FUNCT__ "TSView_ARKIMEX" 1212 static PetscErrorCode TSView_ARKIMEX(TS ts,PetscViewer viewer) 1213 { 1214 TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data; 1215 ARKTableau tab = ark->tableau; 1216 PetscBool iascii; 1217 PetscErrorCode ierr; 1218 TSAdapt adapt; 1219 1220 PetscFunctionBegin; 1221 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr); 1222 if (iascii) { 1223 TSARKIMEXType arktype; 1224 char buf[512]; 1225 ierr = TSARKIMEXGetType(ts,&arktype);CHKERRQ(ierr); 1226 ierr = PetscViewerASCIIPrintf(viewer," ARK IMEX %s\n",arktype);CHKERRQ(ierr); 1227 ierr = PetscFormatRealArray(buf,sizeof(buf),"% 8.6f",tab->s,tab->ct);CHKERRQ(ierr); 1228 ierr = PetscViewerASCIIPrintf(viewer," Stiff abscissa ct = %s\n",buf);CHKERRQ(ierr); 1229 ierr = PetscFormatRealArray(buf,sizeof(buf),"% 8.6f",tab->s,tab->c);CHKERRQ(ierr); 1230 ierr = PetscViewerASCIIPrintf(viewer,"Stiffly accurate: %s\n",tab->stiffly_accurate ? "yes" : "no");CHKERRQ(ierr); 1231 ierr = PetscViewerASCIIPrintf(viewer,"Explicit first stage: %s\n",tab->explicit_first_stage ? "yes" : "no");CHKERRQ(ierr); 1232 ierr = PetscViewerASCIIPrintf(viewer,"FSAL property: %s\n",tab->FSAL_implicit ? "yes" : "no");CHKERRQ(ierr); 1233 ierr = PetscViewerASCIIPrintf(viewer," Nonstiff abscissa c = %s\n",buf);CHKERRQ(ierr); 1234 } 1235 ierr = TSGetAdapt(ts,&adapt);CHKERRQ(ierr); 1236 ierr = TSAdaptView(adapt,viewer);CHKERRQ(ierr); 1237 ierr = SNESView(ts->snes,viewer);CHKERRQ(ierr); 1238 PetscFunctionReturn(0); 1239 } 1240 1241 #undef __FUNCT__ 1242 #define __FUNCT__ "TSLoad_ARKIMEX" 1243 static PetscErrorCode TSLoad_ARKIMEX(TS ts,PetscViewer viewer) 1244 { 1245 PetscErrorCode ierr; 1246 SNES snes; 1247 TSAdapt tsadapt; 1248 1249 PetscFunctionBegin; 1250 ierr = TSGetAdapt(ts,&tsadapt);CHKERRQ(ierr); 1251 ierr = TSAdaptLoad(tsadapt,viewer);CHKERRQ(ierr); 1252 ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr); 1253 ierr = SNESLoad(snes,viewer);CHKERRQ(ierr); 1254 /* function and Jacobian context for SNES when used with TS is always ts object */ 1255 ierr = SNESSetFunction(snes,NULL,NULL,ts);CHKERRQ(ierr); 1256 ierr = SNESSetJacobian(snes,NULL,NULL,NULL,ts);CHKERRQ(ierr); 1257 PetscFunctionReturn(0); 1258 } 1259 1260 #undef __FUNCT__ 1261 #define __FUNCT__ "TSARKIMEXSetType" 1262 /*@C 1263 TSARKIMEXSetType - Set the type of ARK IMEX scheme 1264 1265 Logically collective 1266 1267 Input Parameter: 1268 + ts - timestepping context 1269 - arktype - type of ARK-IMEX scheme 1270 1271 Level: intermediate 1272 1273 .seealso: TSARKIMEXGetType(), TSARKIMEX, TSARKIMEX2D, TSARKIMEX2E, TSARKIMEXPRSSP2, TSARKIMEX3, TSARKIMEXBPR3, TSARKIMEXARS443, TSARKIMEX4, TSARKIMEX5 1274 @*/ 1275 PetscErrorCode TSARKIMEXSetType(TS ts,TSARKIMEXType arktype) 1276 { 1277 PetscErrorCode ierr; 1278 1279 PetscFunctionBegin; 1280 PetscValidHeaderSpecific(ts,TS_CLASSID,1); 1281 ierr = PetscTryMethod(ts,"TSARKIMEXSetType_C",(TS,TSARKIMEXType),(ts,arktype));CHKERRQ(ierr); 1282 PetscFunctionReturn(0); 1283 } 1284 1285 #undef __FUNCT__ 1286 #define __FUNCT__ "TSARKIMEXGetType" 1287 /*@C 1288 TSARKIMEXGetType - Get the type of ARK IMEX scheme 1289 1290 Logically collective 1291 1292 Input Parameter: 1293 . ts - timestepping context 1294 1295 Output Parameter: 1296 . arktype - type of ARK-IMEX scheme 1297 1298 Level: intermediate 1299 1300 .seealso: TSARKIMEXGetType() 1301 @*/ 1302 PetscErrorCode TSARKIMEXGetType(TS ts,TSARKIMEXType *arktype) 1303 { 1304 PetscErrorCode ierr; 1305 1306 PetscFunctionBegin; 1307 PetscValidHeaderSpecific(ts,TS_CLASSID,1); 1308 ierr = PetscUseMethod(ts,"TSARKIMEXGetType_C",(TS,TSARKIMEXType*),(ts,arktype));CHKERRQ(ierr); 1309 PetscFunctionReturn(0); 1310 } 1311 1312 #undef __FUNCT__ 1313 #define __FUNCT__ "TSARKIMEXSetFullyImplicit" 1314 /*@C 1315 TSARKIMEXSetFullyImplicit - Solve both parts of the equation implicitly 1316 1317 Logically collective 1318 1319 Input Parameter: 1320 + ts - timestepping context 1321 - flg - PETSC_TRUE for fully implicit 1322 1323 Level: intermediate 1324 1325 .seealso: TSARKIMEXGetType() 1326 @*/ 1327 PetscErrorCode TSARKIMEXSetFullyImplicit(TS ts,PetscBool flg) 1328 { 1329 PetscErrorCode ierr; 1330 1331 PetscFunctionBegin; 1332 PetscValidHeaderSpecific(ts,TS_CLASSID,1); 1333 ierr = PetscTryMethod(ts,"TSARKIMEXSetFullyImplicit_C",(TS,PetscBool),(ts,flg));CHKERRQ(ierr); 1334 PetscFunctionReturn(0); 1335 } 1336 1337 #undef __FUNCT__ 1338 #define __FUNCT__ "TSARKIMEXGetType_ARKIMEX" 1339 PetscErrorCode TSARKIMEXGetType_ARKIMEX(TS ts,TSARKIMEXType *arktype) 1340 { 1341 TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data; 1342 PetscErrorCode ierr; 1343 1344 PetscFunctionBegin; 1345 if (!ark->tableau) { 1346 ierr = TSARKIMEXSetType(ts,TSARKIMEXDefault);CHKERRQ(ierr); 1347 } 1348 *arktype = ark->tableau->name; 1349 PetscFunctionReturn(0); 1350 } 1351 #undef __FUNCT__ 1352 #define __FUNCT__ "TSARKIMEXSetType_ARKIMEX" 1353 PetscErrorCode TSARKIMEXSetType_ARKIMEX(TS ts,TSARKIMEXType arktype) 1354 { 1355 TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data; 1356 PetscErrorCode ierr; 1357 PetscBool match; 1358 ARKTableauLink link; 1359 1360 PetscFunctionBegin; 1361 if (ark->tableau) { 1362 ierr = PetscStrcmp(ark->tableau->name,arktype,&match);CHKERRQ(ierr); 1363 if (match) PetscFunctionReturn(0); 1364 } 1365 for (link = ARKTableauList; link; link=link->next) { 1366 ierr = PetscStrcmp(link->tab.name,arktype,&match);CHKERRQ(ierr); 1367 if (match) { 1368 ierr = TSReset_ARKIMEX(ts);CHKERRQ(ierr); 1369 ark->tableau = &link->tab; 1370 PetscFunctionReturn(0); 1371 } 1372 } 1373 SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_ARG_UNKNOWN_TYPE,"Could not find '%s'",arktype); 1374 PetscFunctionReturn(0); 1375 } 1376 #undef __FUNCT__ 1377 #define __FUNCT__ "TSARKIMEXSetFullyImplicit_ARKIMEX" 1378 PetscErrorCode TSARKIMEXSetFullyImplicit_ARKIMEX(TS ts,PetscBool flg) 1379 { 1380 TS_ARKIMEX *ark = (TS_ARKIMEX*)ts->data; 1381 1382 PetscFunctionBegin; 1383 ark->imex = (PetscBool)!flg; 1384 PetscFunctionReturn(0); 1385 } 1386 1387 /* ------------------------------------------------------------ */ 1388 /*MC 1389 TSARKIMEX - ODE and DAE solver using Additive Runge-Kutta IMEX schemes 1390 1391 These methods are intended for problems with well-separated time scales, especially when a slow scale is strongly 1392 nonlinear such that it is expensive to solve with a fully implicit method. The user should provide the stiff part 1393 of the equation using TSSetIFunction() and the non-stiff part with TSSetRHSFunction(). 1394 1395 Notes: 1396 The default is TSARKIMEX3, it can be changed with TSARKIMEXSetType() or -ts_arkimex_type 1397 1398 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). 1399 1400 Level: beginner 1401 1402 .seealso: TSCreate(), TS, TSSetType(), TSARKIMEXSetType(), TSARKIMEXGetType(), TSARKIMEXSetFullyImplicit(), TSARKIMEX2D, TTSARKIMEX2E, TSARKIMEX3, 1403 TSARKIMEX4, TSARKIMEX5, TSARKIMEXPRSSP2, TSARKIMEXBPR3, TSARKIMEXType, TSARKIMEXRegister() 1404 1405 M*/ 1406 #undef __FUNCT__ 1407 #define __FUNCT__ "TSCreate_ARKIMEX" 1408 PETSC_EXTERN PetscErrorCode TSCreate_ARKIMEX(TS ts) 1409 { 1410 TS_ARKIMEX *th; 1411 PetscErrorCode ierr; 1412 1413 PetscFunctionBegin; 1414 ierr = TSARKIMEXInitializePackage();CHKERRQ(ierr); 1415 1416 ts->ops->reset = TSReset_ARKIMEX; 1417 ts->ops->destroy = TSDestroy_ARKIMEX; 1418 ts->ops->view = TSView_ARKIMEX; 1419 ts->ops->load = TSLoad_ARKIMEX; 1420 ts->ops->setup = TSSetUp_ARKIMEX; 1421 ts->ops->step = TSStep_ARKIMEX; 1422 ts->ops->interpolate = TSInterpolate_ARKIMEX; 1423 ts->ops->evaluatestep = TSEvaluateStep_ARKIMEX; 1424 ts->ops->setfromoptions = TSSetFromOptions_ARKIMEX; 1425 ts->ops->snesfunction = SNESTSFormFunction_ARKIMEX; 1426 ts->ops->snesjacobian = SNESTSFormJacobian_ARKIMEX; 1427 1428 ierr = PetscNewLog(ts,&th);CHKERRQ(ierr); 1429 ts->data = (void*)th; 1430 th->imex = PETSC_TRUE; 1431 1432 ierr = PetscObjectComposeFunction((PetscObject)ts,"TSARKIMEXGetType_C",TSARKIMEXGetType_ARKIMEX);CHKERRQ(ierr); 1433 ierr = PetscObjectComposeFunction((PetscObject)ts,"TSARKIMEXSetType_C",TSARKIMEXSetType_ARKIMEX);CHKERRQ(ierr); 1434 ierr = PetscObjectComposeFunction((PetscObject)ts,"TSARKIMEXSetFullyImplicit_C",TSARKIMEXSetFullyImplicit_ARKIMEX);CHKERRQ(ierr); 1435 PetscFunctionReturn(0); 1436 } 1437