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