Difference of finite difference solution between two timesteps - fortran

I have a solution to a discretized differential equation given by
f(i)
where i is a spatial index. How can I find the difference between the solution at each adjacent time step? To be more clear:
The solution is defined by an array
real,dimension(0:10) :: f
I discretize the differential equation and solve it by stepping forward in time. If the time index is k, a portion of my code is
do k=1,25
do i = 1,10
f(i) = f(i+1)+f(i-1)+f(i)
end do
end do
I can print the solution, f(i) at each time step k by the following code
print*, "print f(i) for k=, k
print "(//(5(5x,e22.14)))", f
How can I find the difference between the solution at each adjacent time step? That is, time steps k+1,k. I will store this value in a new array g, which has a dimension given by
real,dimension(0:10) :: g
So I am trying to find
!g(i)=abs(f(i;k+1)-f(i;k))...Not correct code.
How can I do this? What is the way to implement this code? I am not sure how to do this using if /then statements or whatever code would need be needed to do this. Thanks

Typically, in explicit time integration methods or iterative methods, you have to save the last time-step last solution, the current time-step solution and possibly even some more.
So you have
real,dimension(0:10) :: f0, f
where f0 is the previous value
You iterate your Jacobi or Gauss-Seidel discretization:
f = f0
do k=1,25
do i = 1,9
f(i) = f(i+1)+f(i-1)+f(i)
end do
max_diff = maxval(abs(f-f0))
if (diff small enough) exit
f0 = f
end do
If you have a time-evolving problem like a heat equation:
f = f0
do k=1,25
do i = 1,9
f(i) = f0(i) + dt * viscosity * (f0(i+1)+f0(i-1)+f0(i))
end do
max_diff = maxval(abs(f-f0))
f0 = f
end do

You have a spatial mesh at each point time. Transient problems require that you calculate the value at the end of a time step based on the values at the start:
f(i, j+1) = f(i, j) + f(dot)(i, j)*dt // Euler integration where f(dot) = df/dt derivative
i is the spatial index; j is the temporal one.

Related

Infinite loop while implementing Runge-Kutta method with step correction

I'm implementing the Runge-Kutta-4 method for ODE approximation with a step correction procedure.
Here's the code:
function RK4 (v,h,cant_ec) !Runge-Kutta 4to Orden
real(8),dimension(0:cant_ec)::RK4,v
real::h
integer::cant_ec
real(8),dimension(0:cant_ec)::k1,k2,k3,k4
k1 = h*vprima(v)
k2 = h*vprima(v+k1/2.0)
k3 = h*vprima(v+k2/2.0)
k4 = h*vprima(v+k3)
v = v + (k1+2.0*k2+2.0*k3+k4)/6.0 !la aproximación actual con paso h
RK4 = v
end function RK4
subroutine RK4h1(v,h,xf,tol,cant_ec) !Runge-Kutta con corrección de paso por método 1
real(8),dimension(0:cant_ec)::v
real::h,tol,xf
integer::cant_ec,i,n
real(8),dimension(0:cant_ec)::v1,v2
real(8)::error
n = int((xf-v(0))/h +0.5)
open(2,file = "derivada.txt",status="replace")
error = 2*tol
do i = 1,n, 1
do while(error > tol)
v1 = RK4(v,h,cant_ec)
v2 = RK4(v,h/2,cant_ec)
v2 = v2 + RK4(v+v2,h/2,cant_ec)
error = MAXVAL(ABS(v1-v2))
if (error > tol) then
h = h/2
end if
end do
end do
write(*,*)v1
write(2,*)v1
close(2,status="keep")
call system("gnuplot -persist 'derivada.p'")
end subroutine Rk4h1
Where h is the step size, v is a vector of cant_ec components that corresponds to the order of the ODE (that is: v(0) = x,v(1) = y,v(2) = y', etc), tol is the tolerance of error and xf is the end of the x interval (assuming it starts at 0). All these values are inputted by the user before the subroutine call. The initial values given for this particular function are y(0) = -1. Everything else is defined by the user when running the script.
The differential equation is given by:
function vprima(v,x,y) !definición de la función derivada
real(8),dimension(0:cant_ec)::v,vprima
vprima(0) = 1.0
vprima(1) = (-v(1)/(v(0)**2+1))
end function vprima
noting that on the main program this assignment occurs:
v(0) = x
v(1) = y
where x and y are the initial values of the function, given by the user.
My issue is, the script seems to get stuck on an infinite loop when I call RK4h1.
Any help, or clue, would be appreciated. Thank you.
v2 = v2 + RK4(v+v2,h/2,cant_ec) is wrong, it should be v2 = RK4(v2,h/2,cant_ec), as the result of RK4 is the next point, not the update to the next point. As the error calculation is thus wrong, the step size gets reduced indefinitely. After some 50 reductions, the RK4 step will no longer advance the state, the increment being too small.
It will lead to problems if you have a fixed step number with a variable step size.
The inner loop does not make any sense whatsoever. The overall effect is that after each step size reduction i gets incremented by one. So theoretically, if n<50 the program should terminate, but with a final state very close to the initial state.
The local error should be compared to tol*h, so that the global error becomes proportional to tol.
There should also be an instruction that increases h if the local error becomes too small.
See How to perform adaptive step size using Runge-Kutta fourth order (Matlab)? for another example of using RK4 with step-size control by double steps.

Foucault Pendulum simulation

Program Foucault
IMPLICIT NONE
REAL,DIMENSION(:),ALLOCATABLE :: t, x,y
REAL,PARAMETER :: pi=3.14159265358979323846, g=9.81
REAL :: L, vitessea, lat, h, omega, beta
INTEGER :: i , zeta
zeta=1000
Allocate(x(zeta),y(zeta),t(zeta))
L=67.
lat=49/180*pi
omega=sqrt(g/L)
h=0.01
Do i= 1,zeta
IF(i==1 .OR. i==2) THEN
t(1)=0.0
t(2)=0.0
x(1)=0.1
x(2)=1
y(1)=0.0
y(2)=0.0
ELSE
t(i+1)=real(i)*h
x(i+1)=(-omega**2*x(i)+2.0*((y(i)-y(i-1))/h)*latang(lat))*h**2+2.0*x(i)-x(i-1)
y(i+1)=(-omega**2*y(i)-2.0*((x(i)-x(i-1))/h)*latang(lat))*h**2+2.0*y(i)-y(i-1)
END IF
WRITE(40,*) t(i), x(i)
WRITE(60,*) t(i), y(i)
WRITE(50,*) x(i), y(i)
END DO
Contains
REAL Function latang(alpha)
REAL, INTENT(IN) :: alpha
REAL :: sol
latang=2*pi*sin(alpha)/86400
END FUNCTION
End Program Foucault
I'm trying to code the original Foucault Pendulum in Paris. My code seems to be working but so far, I could only get the below right graphic, "the flower" evolution. Therefore, I changed my parameters constantly to get the left graphic but I couldn't.
I took parameters of Foucault Pendulum installed in Paris with L=67, angular velocity of earth =2*pi/86400 and latitude of 49/180*pi.
My initial conditions are as written in the code. I tried a way range of parameters varying all of my initial conditions, my latitude and angular velocity but i couldn't get the left desired results.
I used Foucault differential equations as below : i coded them with Finite difference method (more simple than Runge-Kutta) by replacing the 2nd order derivation by its central finite difference. And the first order one by it's backward finite difference. By then, i build my loop by isolating x(i+1) and y(i+1) in both equations.
My code is very sensitive to parameters such as h (=derivation step), earth angular velocity and latitude (which is normal). I tried to change a way big range of parameters from a big h step to a small one, to a minimal and high latitude, initial conditions...etc but i couldn't ever get the left graphic which i rather need.
What could be made to get the left one ?
I was able to get the two charts, by speeding up the earth's rotation 120× fold, and allowing the simulation to run for 32 swings of the pendulum. Also, I noticed that Euler integration added energy to the system making for bad results, so I reverted to a standard RK4 implementation.
and here is the code I used to solve this ODE:
program FoucaultOde
implicit none
integer, parameter :: sp = kind(1.0), dp = kind(1d0)
! Constants
real, parameter :: g=9.80665, pi =3.1415926536
! Variables
real, allocatable :: y(:,:), yp(:), k0(:),k1(:),k2(:),k3(:)
real :: lat, omega, h, L, earth, period
real :: t0,x0,y0,vx0,vy0
integer :: i, zeta, f1, swings
! Code starts here
swings = 32
zeta = 400*swings
L = 67
lat = 49*pi/180
period = 24*60*60 ! period = 86400
earth = (2*pi*sin(lat)/period)*120 !120 multiplier for roation
omega = sqrt(g/L)
allocate(y(5,zeta))
allocate(yp(5), k0(5),k1(5),k2(5),k3(5))
! make pendulum complete 'swings' cycles in 'zeta' steps
h = swings*2*pi/(omega*zeta)
t0 = 0
x0 = 0.5 ! Initial displacement
y0 = 0
vx0 = 0
vy0 = 0
! Initial conditions in the state vector Y
Y(:,1) = [t0,x0,y0,vx0,vy0]
do i=2, zeta
! Euler method (single step)
! Yp = ode(Y(:,i-1))
! Runge-Kutta method (four steps)
k0 = ode(Y(:,i-1))
k1 = ode(Y(:,i-1) + h/2*k0)
k2 = ode(Y(:,i-1) + h/2*k1)
k3 = ode(Y(:,i-1) + h*k2)
Yp = (k0+2*k1+2*k2+k3)/6
! Take a step
Y(:,i) = Y(:,i-1) + h*Yp
end do
open( newunit=f1, file='results.csv', status = 'replace', pad='no')
! write header
write (f1, '(a15,a,a15,a,a15,a,a15,a,a15)') 't',',', 'x',',','y',',', 'vx',',','vy'
! write rows of data, comma-separated
do i=1, zeta
write (f1, '(g,a,g,a,g,a,g,a,g)') y(1,i),',',y(2,i),',',y(3,i),',',y(4,i),',',y(5,i)
end do
close(f1)
contains
function ode(Y) result(Yp)
real, intent(in) :: Y(5)
real :: Yp(5), t,px,py,vx,vy,ax,ay
! Read state vector Y to component values
t = Y(1)
px = Y(2)
py = Y(3)
vx = Y(4)
vy = Y(5)
! Reference paper:
! http://www.legi.grenoble-inp.fr/people/Achim.Wirth/final_version.pdf
ax = -(omega**2)*px + 2*vy*earth ! (equation 53)
ay = -(omega**2)*py - 2*vx*earth ! (equation 54)
! State vector rate. Note, rate of time is aways 1.0
Yp = [1.0, vx, vy, ax, ay]
end function
end program FoucaultOde
The resulting file results.csv looks like this for me (for checking)
t, x, y, vx, vy
.000000 , 5.000000 , .000000 , .000000 , .000000
.4105792E-01, 4.999383 , .1112020E-06, -.3004657E-01, .8124921E-05
.8211584E-01, 4.997533 , .8895339E-06, -.6008571E-01, .3249567E-04
.1231738 , 4.994450 , .3001796E-05, -.9011002E-01, .7310022E-04
.1642317 , 4.990134 , .7114130E-05, -.1201121 , .1299185E-03
.2052896 , 4.984587 , .1389169E-04, -.1500844 , .2029225E-03
.2463475 , 4.977810 , .2399832E-04, -.1800197 , .2920761E-03
.2874054 , 4.969805 , .3809619E-04, -.2099106 , .3973353E-03
...
from which I plotted the 2nd and 3rd columns in one chart, and the 4th and 5th for the second chart.
There is one thing that may be wrong depending on how you manage different step sizes, and an observation on the physics of the real-world example. With the initialization of the arrays, you imply an initial velocity of about 0.9/0.01=90 [m/s] in x direction away from the center. To get compatible results for different step sizes, you would need to adapt the calculation of x(2). However, in the graphs the plot starts from a point with zero velocity. This you can implement to first order by setting x(2)=x(1)=1. As the used integration method is also first order, this is sufficient.
For the second point, note that one can write the system using complex coordinates z=x+iy as
z'' = -w^2*z - 2*i*E*z', E = Omega*sin(theta)
This is a linear ODE with constant coefficients, the solution of it is
z(t) = exp(-i*E*t) * (A*cos(w1*t)+B*sin(w1*t)), w1 = sqrt(w^2+E^2)
This describes a pendulum motion of frequency w1 whose plane rotates with frequency E clockwise. The grand rotation has period T=2*pi/E, during which w1*T/(2*pi)=w1/E pendulum swings occur.
Now insert your numbers, w=sqrt(g/L)=0.383 and E=2*pi*sin(49°)/86400=5.49e-05, so that essentially w1=w. The number of pendulum cycles per full rotation is w/E=6972, so that you can expect a densely filled circle in the plot. Or a very narrow double wedge if only a few cycles are plotted. As each cycle takes 2*pi/w=16.4 [s], and the integration goes 1000 steps of step size 0.01, in the plot as it is you can expect a swing forth and part of the swing back.
To be more realistic, set the initial velocity to zero, that is, the pendulum is taken to its start position and then let go. Also increase the time to 30 [s] to have more than one pendulum cycle in the plot.
It from this we can see that the solutions converge, and with some imagination, that they converge linearly.
To get a plot like in the cited images, one needs a much smaller fraction of w/E, counting the swings, it has to be around 15. Note that you can not get this ratio anywhere on earth with a realistically scaled pendulum. So set w=pi, E=pi/16 and integrate over 15 time units using the first order method.
This detoriorates really fast, even for the smallest step size with 40 points in a pendulum cycle.
For a better result, increase the local truncation order to the next higher by using the central difference in the first derivative approximation.
z(i+1) - 2*z(i) + z(i-1) = -w^2*z(i)*dt^2 - i*E*(z(i+1)-z(i-1))*dt
z(i+1) = ( 2*z(i) - z(i-1) - w^2*z(i)*dt^2 + i*E*z(i-1)*dt ) / (1+i*E*dt)
The division by the complex number can also be easily carried out in the real components of the trajectory,
! x(i+1)-2*x(i)+x(i-1) = h^2*(-omega**2*x(i)) + h*earth*(y(i+1)-y(i-1))
! y(i+1)-2*y(i)+y(i-1) = h^2*(-omega**2*y(i)) - h*earth*(x(i+1)-x(i-1))
t(i) = t(i-1) + h
cx = (2-(h*omega)**2)*x(i) - x(i-1) - h*earth*y(i-1)
cy = (2-(h*omega)**2)*y(i) - y(i-1) + h*earth*x(i-1)
den = 1+(h*earth)**2
x(i+1) = (cx + h*earth*cy)/den
y(i+1) = (cy - h*earth*cx)/den
Now to respect the increased order, also the initial points need to have an order of accuracy more, using again zero initial speed, this gives in the second order Taylor expansion
z(2) = z(1) - 0.5*w^2*z(1)*dt^2
All the step sizes that gave deviating and structurally deteriorating results in the first order method now give a visually identical, structurally stable results in this second order method.

Fortan code for Monte Carlo Integration within boundary point a and b

I understand Monte carlo simulation is for estimating area by plotting random points and calculating the ration between the points outside the curve and inside the curve.
I have well calculated the value of pi assuming radius of curve to be unity.
Here is the code
program pi
implicit none
integer :: count, n, i
real :: r, x, y
count = 0
n=500
CALL RANDOM_SEED
DO i = 1, n
CALL RANDOM_NUMBER(x)
CALL RANDOM_NUMBER(y)
IF (x*x + y*Y <1.0) count = count + 1
END DO
r = 4 * REAL(count)/n
print *, r
end program pi
But to find integration , Textbook says to apply same idea. But I'm lost on How to write a code if I want to find the integration of
f(x)=sqrt(1+x**2) over a = 1 and b = 5
Before when radius was one, I did assume point falling inside by condition x*2+y**2 but How can I solve above one?
Any help is extremely helpful
I will write the code first and then explain:
Program integral
implicit none
real f
integer, parameter:: a=1, b=5, Nmc=10000000 !a the lower bound, b the upper bound, Nmc the size of the sampling (the higher, the more accurate the result)
real:: x, SUM=0
do i=1,Nmc !Starting MC sampling
call RANDOM_NUMBER(x) !generating random number x in range [0,1]
x=a+x*(b-a) !converting x to be in range [a,b]
SUM=SUM+f(x) !summing all values of f(x). EDIT: SUM is also an instrinsic function in Fortran so don't call your variable this, I named it so, to illustrate its purpose
enddo
print*, (b-a)*(SUM/Nmc) !final result of your integral
end program integral
function f(x) !defining your function
implicit none
real, intent(in):: x
real:: f
f=sqrt(1+x**2)
end function f
So what's happening:
The integral can be written as
. where:
(this g(x) is a uniform probability distribution of the variable x in [a,b]). And we can write the integral as:
where .
So, finally, we get that the integral should be:
So, all you have to do is generate a random number in the range [a,b] and then calcualte the value of your function for this x. Then do this lots of times (Nmc times), and calculate the sum. Then just divide with Nmc, to find the average and then multiply with (b-a). And this is what the code does.
There's lots of stuff on the internet for this. here's one example that visualizes it pretty nice
EDIT: Second way, that is the same as the Pi method:
Nin=0 !Number of points inside the function (under the curve)
do i=1,Nmc
call random_number(x)
call random_number(y)
x=a+x*(b-a)
y=f_min+y(f_max-f_min)
if (f(x)<y) Nin=Nin+1
enddo
print*, (f_max-f_min)*(b-a)*(real(Nin)/Nmc)
All of this, you could then enclose it in an outer do loop summing the (f_max-f_min)(b-a)(real(Nin)/Nmc) and in the end printing its average.
For this example, what you do is essentially creating an enclosing box from a to b (x dimension) and from f_min to f_max (y dimension) and then doing a sampling of points inside this area and counting the points that are in the function (Nin).Obviously you will have to know the minimum (f_min) and maximum (f_max) value of your function in the range [a,b]. Alternatively you could use arbitrarily low/high values for your f_min f_max but then you will be wasting a lot of points and your error will be bigger.

Convolution vs signal resolution

I realized that the resolution of the input signal dramatically affects the results of the convolution. I'm wondering if there is a way to compensate somehow for this. Let me give you an example:
Lets take the Sersic equation:
Sersic
with, for example, parameters.
Now we solve this equation both for a R step of 0.1 and 0.01. For example for the 1st point (R=0) we get \mu(0) = 9.82.
The next step is to convolve the data, after converting it into counts (to convert it to counts we can use this simple equation: Data(R) = 10^((\mu(R)-25)/(-2.5)). I'm using the bellow mentioned subroutine that I wrote but I tried with others and I get the same result (the PSF is Moffat with FWHM = 0.5 arcsec and its constructed in a way that its total area equals 1):
sum1 = 0
DO i = 1,n
sum1 = 0
g = i
DO f = 1,i
sum1(f) = Data(f)*PSF(g)
g = i - f
ENDDO
convData(i) = sum(sum1)
ENDDO
convData = convData(n:1:-1)
So, for this example, for the data with 0.1 resolution after convolution (and after reconverting the counts to \mu) I get for \mu(0)* = 13.52. For the data with 0.01 resolution I get \mu(0)* = 15.52. This is 2 magnitudes difference!! What am I doing wrong or how can I somehow compensate for this effect?
Thank you so much for the help!

2D rigid body physics using runge kutta

Does anyone know any c++/opengl sourcecode demos for 2D rigid body physics using runge kutta?
I want to build a physics engine but I need some reference code to understand better how others have implemented this.
There are a lot of things you have to take care to do this nicely. I will focus on the integrator implementation and what I have found works good for me.
For all the degrees of freedom in your system implement a function to return the accelerations a as a function of time t, positions x and velocities v. This should operate on arrays or vectors of quantities and not just scalars.
a = accel(t,x,v);
After each RK step evaluate the acceleration to be ready for the next step. In the loop then do this:
{
// assume t,x[],v[], a[] are known
// step time t -> t+h and calc new values
float h2=h/2;
vec q1 = v + h2*a;
vec k1 = accel(t+h2, x+h2*v, q1);
vec q2 = v + h2*k1;
vec k2 = accel(t+h2, x+h2*q1, q2);
vec q3 = v + h*k2;
vec k3 = accel(t_h, x+h*q2, q3);
float h6 = h/6;
t = t + h;
x = x + h*(v+h6*(a+k1+k2));
v = v + h6*(a+2*k1+2*k2+k3);
a = accel(t,x,v);
}
Why? Well the standard RK method requires you to make a 2xN state vector, but the derivatives of the fist N elements are equal to the last N elements. If you split the problem up to two N state vectors and simplify a little you will arrive at the above scheme for 2nd order RK.
I have done this and the results are identical to commercial software for a plan system with N=6 degrees of freedom.