TransWikia.com

Precision in Integrals and NDSolve

Mathematica Asked on April 20, 2021

I have a simplest code for NDSolve, the problem is I am dividing two small numbers, the denominator is so small that it gives me infinity as an answer, how can I increase the precision to get a reasonable answer.
N1 = 100000;
th = [Pi]/4;

s0 = 0.01 + 0.007 Sin[th];


h = 0.3;
nst0 =
  NDSolve[{
    
    (x (1 - x))/(2 N1) D[T0[x], x, x] +  
      s0  x (1 - x)  (x + h (1 - 2 x )) D[T0[x], x] == -!(
*SubsuperscriptBox[([Integral]), (0), (x)](
*SuperscriptBox[(E), ((-  N1) s0 a ((a  +  
            2 h ((1 - a)))))] [DifferentialD]a))/!(
*SubsuperscriptBox[([Integral]), (0), (1)](
*SuperscriptBox[(E), ((- 
          N1) s0 a ((a  +  
           2 h ((1 - a)))))] [DifferentialD]a))  ,
    T0[0.000000001] == 0, T0[.99999999] == 0 
    
    }, {T0}, {x, 0.000000001, .99999999}];
T0e = T0 /. First@nst0;



T0e[1/(2 N1)]/(!(
*SubsuperscriptBox[([Integral]), (0), (1/((2 N1)))](
*SuperscriptBox[(E), ((-  N1) s0 a ((a  +  
        2 h ((1 - a)))))] [DifferentialD]a))/!(
*SubsuperscriptBox[([Integral]), (0), (1)](
*SuperscriptBox[(E), ((- 
       N1) s0 a ((a  +  
        2 h ((1 - a)))))] [DifferentialD]a)))

2 Answers

improved answer

Here I'll show how to solve your problem which is singular for x==0 and x==1 and illscaled for N1>>1

First the differential equation

s0 = 0.01 + 0.007/1000 Sin[th] // Rationalize;
h = 0.3 // Rationalize;
th = Pi/4;
ode[N1_] := (x (1 - x))/(2 N1) D[T0[x], x, x] +  
             s0  x (1 - x)  (x + h (1 - 2 x )) D[T0[x], x] == -Integrate[
         E^(-  N1 s0 a (a + 2 h (1 - a))), {a, 0, x}]/
       Integrate[E^(- N1 s0 a (a + 2 h (1 - a))), {a, 0, 1}] 

solution of the ode N1=10000

T = With[{e = 10^-10, N1 = 10000}, 
NDSolveValue[{ode[N1],
         T0[e] == 0, T0[1 - e] == 0}, {T0}, {x, e, 1 - e} ][[1]] ] 

Plot[T[x], {x, 0, 1}] 

enter image description here

That solves your problem in principle.

I don't have more time to elaborate the case N1=100000 which needs numerical finetuning concerning WorkingPrecision&Co ...

case N1=100000

Thanks to the answer @Dominic ,which let me to the idea using $MaxExtraPrecision = 100 . Blockinstead of With (don't know why it's necessary) evaluates to

T = Block[{$MaxExtraPrecision = 100, e = 10^-10, N1 = 100000}, 
NDSolveValue[{ode[N1], T0[e] == 0, T0[1 - e] == 0}, {T0}, {x, e,1 - e}, 
WorkingPrecision -> 35][[1]]] 
Plot[T[x], {x, 0, 1}]

enter image description here

Answered by Ulrich Neumann on April 20, 2021

Using Ulrich's code above, adjust MaxStepSize, MaxSteps and WorkingPrecision as needed. This is the code for N1=30000 on a 3.5 GHz machine. Note I set up the problem for arbitrary precision arithmetic (use rational numbers for constants) and then set working precision to 25:

th = Pi/4;
s0 = 1/100 + 7/1000 Sin[th]
h = 3/10

ode[N1_] := (x (1 - x))/(2 N1) D[T0[x], x, x] + 
   s0 x (1 - x) (x + h (1 - 2 x)) D[T0[x], x] == -Integrate[
     E^(-N1 s0 a (a + 2 h (1 - a))), {a, 0, x}]/
   Integrate[E^(-N1 s0 a (a + 2 h (1 - a))), {a, 0, 1}]

AbsoluteTiming[
T=With[{e=10^-10,N1=30000},NDSolveValue[{ode[N1],T0[e]==0,T0[1-e]==0},{T0},{x,e,1-e},
MaxStepSize->1/20000,
MaxSteps->1000000,
WorkingPrecision->25][[1]]];
]

Out[61]= {26.3717,Null}

enter image description here

Answered by Dominic on April 20, 2021

Add your own answers!

Ask a Question

Get help from others!

© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP