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