MathGroup Archive 2010

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Re: Modification of Variable in NDSolve

  • To: mathgroup at smc.vnet.net
  • Subject: [mg108069] Re: [mg108007] Re: Modification of Variable in NDSolve
  • From: DrMajorBob <btreat1 at austin.rr.com>
  • Date: Sun, 7 Mar 2010 05:10:01 -0500 (EST)
  • References: <hmiikh$3r6$1@smc.vnet.net> <hmlese$jmc$1@smc.vnet.net>
  • Reply-to: drmajorbob at yahoo.com

I'm not sure why you're dividing into intervals (explained in a previous  
post??), but here's a code that loops:

Clear[findCrossing]
findCrossing[{low_, high_, a1Low_, b1Low_, f1Low_}] :=
  Module[{t1, aa, bb, ff, at, bt, ft},
   {t1, {aa, bb, ff}, {at, bt, ft}} =
    Block[{a, b, f, sol, crossings, cross},
     {{sol}, {crossings}} =
      Reap[NDSolve[{a'[t] == dA, b'[t] == dB, f'[t] == dF,
         a[low] == a1Low, b[low] == b1Low, f[low] == f1Low}, {a, b,
         f}, {t, low, high},
        Method -> {"EventLocator", "Event" -> f[t] - 5,
          "Direction" -> 1, "EventAction" :> Sow[t]}]];
     {a, b, f} = {a, b, f} /. sol;
     {cross = First@crossings, {a, b, f}, {a@cross, b@cross, f@cross}}
     ];
   With[{t1 = t1},
    a[t_] /; low <= t < t1 := aa[t];
    b[t_] /; low <= t < t1 := bb[t];
    f[t_] /; low <= t < t1 := ff[t]];
   {t1, 100, at, bt, ft}
   ]

Clear[a, b, f]
NestList[findCrossing, {0, 100, 1, 1, 1}, 3]

{{0, 100, 1, 1, 1}, {19.3041, 100, 1.13918, 2.57013, 5.}, {25.4719,
   100, -0.0943722, 2.07651, 5.}, {31.3054, 100, -1.26109, 0.952159,
   5.}}

t3 = First@Last@%

31.3054

disp = Plot[#[t], {t, 0, t3}, PlotRange -> All] &;
GraphicsGrid[Map[disp, {{a, b}, {f}}, {2}]]

?a

(omitted)

It's odd that I needed With[{t1 = t1},...], but I didn't have to treat  
"low" the same way.

Bobby

On Fri, 05 Mar 2010 03:31:55 -0600, Shawn Garbett  
<shawn.garbett at gmail.com> wrote:

> I took these suggestion into account and now have the following, it's
> crude but works. If I can refine it into a loop, then I'll be done.
>
> First Interval
>
> x1 = Reap[NDSolve[
>    {A'[t] == dA, B'[t] == dB, F'[t] == dF,
>     A[0] == 1, B[0] == 1, F[0] == 1},
>    {A, B, F}, {t, 0, 100},
>    Method -> {
>      "EventLocator",
>      "Event" -> F[t] - 5,
>      "Direction" -> 1,
>      "EventAction" :> Sow[t]
>      }
>    ]]
>
> sol1 = x1[[1]][[1]]
>
> div1 = x1[[2]][[1]][[1]]
>
> Second Interval
>
> x2 = Reap[NDSolve[
>    {A'[t] == dA, B'[t] == dB, F'[t] == dF,
>     A[div1] == (A[div1] /. sol1),
>     B[div1] == (B[div1] /. sol1),
>     F[div1] == (F[div1] /. sol1)/2},
>    {A, B, F}, {t, div1, 100},
>    Method -> {
>      "EventLocator",
>      "Event" -> F[t] - 5,
>      "Direction" -> 1,
>      "EventAction" :> Sow[t]
>      }
>    ]]
>
> sol2 = x2[[1]][[1]]
>
> div2 = x2[[2]][[1]][[1]]a
>
> Third Interval
>
> x3 = Reap[NDSolve[
>    {A'[t] == dA, B'[t] == dB, F'[t] == dF,
>     A[div2] == (A[div2] /. sol2),
>     B[div2] == (B[div2] /. sol2),
>     F[div2] == (F[div2] /. sol2)/2},
>    {A, B, F}, {t, div2, 100},
>    Method -> {
>      "EventLocator",
>      "Event" -> F[t] - 5,
>      "Direction" -> 1,
>      "EventAction" :> Sow[t]
>      }
>    ]]
>
> sol3 = x3[[1]][[1]]
>
> div3 = x3[[2]][[1]][[1]]
>
> AA[t_ /; t <= div1] := (A[t] /. sol1);
> AA[t_ /; div1 < t <= div2] := (A[t] /. sol2) ;
> AA[t_ /; div2 < t <= div3] := (A[t] /. sol3);
>
> BB[t_ /; t <= div1] := (B[t] /. sol1);
> BB[t_ /; div1 < t <= div2] := (B[t] /. sol2) ;
> BB[t_ /; div2 < t <= div3] := (B[t] /. sol3);
>
> FF[t_ /; t <= div1] := (F[t] /. sol1);
> FF[t_ /; div1 < t <= div2] := (F[t] /. sol2) ;
> FF[t_ /; div2 < t <= div3] := (F[t] /. sol3);
>
> disp = Plot[#[t], {t, 0, div3}, PlotRange -> All] &;
> GraphicsGrid[Map[disp, {{AA, BB}, {FF}}, {2}]]
>
>


-- 
DrMajorBob at yahoo.com


  • Prev by Date: Re: removing non-numeric elements from the table
  • Next by Date: Re: Re: Write an expression in a specific form
  • Previous by thread: Re: Re: Modification of Variable in NDSolve
  • Next by thread: Re: Modification of Variable in NDSolve