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