Need help debugging writing to a file in fortran - fortran

I'm writing a code that discretizes a circle and then gives back what points would be in an interval specified by the user. Using variables x,y, and theta, it writes the values of y and theta as they should be to the file info.dat, but writes that x is zero no matter what I do. It has no problem writing to points.dat either. Btw all variables were properly defined from the start as either allocatable, target, pointer, etc.
open(unit=2, file="points.DAT")
print*, 'Please enter the reference angle of the arc in degrees, number of points on the arc, and radius of the arc.'
read(*,*) a, n, r
a = a * pi / 180
allocate(x(1:n),y(1:n),theta(1:n))
do i = 1,n
theta(i:i) = a*(i-1)/n
x(i:i) = r * cos(theta(i:i))
y(i:i) = r * sin(theta(i:i))
xcoord(i:i) => x(i:i)
ycoord(i:i) => y(i:i)
angle(i:i) => theta(i:i)
write(2,*) 'x',i,'=',x(i:i),'y',i,'=',y(i:i), 'theta', i,'=', theta(i:i)
end do
deallocate(x,y,theta)
close(2)
open(unit=3, file="info.DAT")
print*, 'Please specify the interval of interest between 0 and 360 degrees'
read(*,*) b, c
b = b * pi / 180
c = c * pi / 180
do i = 1, n
if (any(b <= angle(i:i) .and. angle(i:i) <= c)) then
write(3,*) 'x', i, '=', xcoord(i:i), 'y', i, '=', ycoord(i:i), 'theta', i, '=', angle(i:i)
end if
end do
close(3)

Although you don't show it xcoord ycoord angle must be declared as POINTER. You set them to point to each single-element slice of x() y() theta() in turn,
leave them pointing to the N'th elements, and then deallocate the underlying arrays so the pointers are now undefined (point to freed memory).
If you have debugging options on your compiler (or possibly runtime) and use them, they should definitely detect the accesses to 1..n-1
while the pointer association is set to (n:n), and might detect that even (n) is invalid because of the deallocation. It appears by good luck the memory formerly used
by x has been clobbered by something else but by bad luck y and theta still have their values.

Related

if statement to determine steady-state

My code below correctly solves a 1D heat equation for a function u(x,t). I now want to find the steady-state solution, the solution that no longer changes in time so it should satisfy u(t+1)-u(t) = 0. What is the most efficient way to find the steady-state solution? I show three different attempts below, but I'm not sure if either are actually doing what I want. The first and third have correct syntax, the second method has a syntax error due to the if statement. Each method is different due to the change in the if structure.
Method 1 :
program parabolic1
integer, parameter :: n = 10, m = 20
real, parameter :: h = 0.1, k = 0.005 !step sizes
real, dimension (0:n) :: u,v
integer:: i,j
real::pi,pi2
u(0) = 0.0; v(0) = 0.0; u(n) = 0.0; v(n) =0.0
pi = 4.0*atan(1.0)
pi2 = pi*pi
do i=1, n-1
u(i) = sin( pi*real(i)*h)
end do
do j = 1,m
do i = 1, n-1
v(i) = 0.5*(u(i-1)+u(i+1))
end do
t = real(j)*k !increment in time, now check for steady-state
!steady-state check: this checks the solutions at every space point which I don't think is correct.
do i = 1,n-1
if ( v(i) - u(i) .LT. 1.0e-7 ) then
print*, 'steady-state condition reached'
exit
end if
end do
do i = 1, n-1 !updating solution
u(i) = v(i)
end do
end do
end program parabolic1
Method 2 :
program parabolic1
integer, parameter :: n = 10, m = 20
real, parameter :: h = 0.1, k = 0.005 !step sizes
real, dimension (0:n) :: u,v
integer:: i,j
real::pi,pi2
u(0) = 0.0; v(0) = 0.0; u(n) = 0.0; v(n) =0.0
pi = 4.0*atan(1.0)
pi2 = pi*pi
do i=1, n-1
u(i) = sin( pi*real(i)*h)
end do
do j = 1,m
do i = 1, n-1
v(i) = 0.5*(u(i-1)+u(i+1))
end do
t = real(j)*k !increment in time, now check for steady-state
!steady-state check: (This gives an error message since the if statement doesn't have a logical scalar expression, but I want to compare the full arrays v and u as shown.
if ( v - u .LT. 1.0e-7 ) then
print*, 'steady-state condition reached'
exit
end if
do i = 1, n-1 !updating solution
u(i) = v(i)
end do
end do
end program parabolic1
Method 3 :
program parabolic1
integer, parameter :: n = 10, m = 20
real, parameter :: h = 0.1, k = 0.005 !step sizes
real, dimension (0:n) :: u,v
integer:: i,j
real::pi,pi2
u(0) = 0.0; v(0) = 0.0; u(n) = 0.0; v(n) =0.0
pi = 4.0*atan(1.0)
pi2 = pi*pi
do i=1, n-1
u(i) = sin( pi*real(i)*h)
end do
do j = 1,m
do i = 1, n-1
v(i) = 0.5*(u(i-1)+u(i+1))
end do
t = real(j)*k !increment in time, now check for steady-state
!steady-state check: Perhaps this is the correct expression I want to use
if( norm2(v) - norm2(u) .LT. 1.0e-7 ) then
print*, 'steady-state condition reached'
exit
end if
do i = 1, n-1 !updating solution
u(i) = v(i)
end do
end do
end program parabolic1
Without discussing which method to determine "closeness" is best or correct (not really being a programming problem) we can focus on what the Fortran parts of the methods are doing.
Method 1 and Method 2 are similar ideas (but broken in their execution), while Method 3 is different (and broken in another way).
Note also that in general one wants to compare the magnitude of the difference abs(v-u) rather than the (signed) difference v-u. With non-monotonic changes over iterations these are quite different.
Method 3 uses norm2(v) - norm2(u) to test whether the arrays u and v are similar. This isn't correct. Consider
norm2([1.,0.])-norm2([0.,1.])
instead of the more correct
norm2([1.,0.]-[0.,1.])
Method 2's
if ( v - u .LT. 1.0e-7 ) then
has the problem of being an invalid array expression, but the "are all points close?" can be written appropriately as
if ( ALL( v - u .LT. 1.0e-7 )) then
(You'll find other questions around here about such array reductions).
Method 1 tries something similar, but incorrectly:
do i = 1,n-1
if ( v(i) - u(i) .LT. 1.0e-7 ) then
print*, 'steady-state condition reached'
exit
end if
end do
This is incorrect in one big way, and one subtle way.
First, the loop is exited when the condition tests true the first time, with a message saying the steady state is reached. This is incorrect: you need all values close, while this is testing for any value close.
Second, when the condition is met, you exit. But you don't exit the time iteration loop, you exit the closeness testing loop. (exit without a construct name leaves the innermost do construct). You'll be in exactly the same situation, running again immediately after this innermost construct whether the tested condition is ever or never met (if ever met you'll get the message also). You will need to use a construct name on the time loop.
I won't show how to do that (again there are other questions here about that), because you also need to fix the test condition, by which point you'll be better off using if(all(... (corrected Method 2) without that additional do construct.
For Methods 1 and 2 you'll have something like:
if (all(v-u .lt 1e-7)) then
print *, "Converged"
exit
end if
And for Method 3:
if (norm2(v-u) .lt. 1e-7) then
print *, "Converged"
exit
end if

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.

How to calculate Pi using Monte Carlo Simulation?

I'm attempting to write a FORTRAN 90 program that calculates Pi using random numbers. These are the steps I know I need to undertake:
Create a randomly placed point on a 2D surface within the range [−1, 1] for x and y, using call random_number(x).
calculate how far away the point is from the origin, i'll need to do both of these steps for N points.
for each N value work out the total amount of points that are less than 1 away from origin. Calculate pi with A=4pir^2
use a do loop to calculate pi as a function of N and output it to a data file. then plot it in a graphing package.
This is what I have:
program pi
implicit none
integer :: count, n, i
real :: r, x, y
count = 0
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
I know i've missed out printing the results to the data file, i'm not sure on how to implement this.
This program gives me a nice value for pi (3.149..), but how can I implement step 4, so that it outputs values for pi as a function of N?
Thanks.
Here is an attempt to further #meowgoesthedog effort...
Program pi
implicit none
integer :: count, n, i
real :: r, x, y
count = 0
Integer, parameter :: Slice_o_Pie = 8
Integer :: Don_McLean
Logical :: Purr = .FALSE.
OPEN(NEWUNIT=Don_McLean, FILE='American.Pie')
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
Purr = .FALSE.
IF(MODULO(I, Slice_o_Pie) == 0) Purr = .TRUE.
IF (Purr) THEN
r = 4 * REAL(count)/i
print *, i, r
WRITE(LUN,*) 'I=',I,'Pi=',Pi
END IF
END DO
CLOSE(Don_McLean)
end program pi
Simply put the final calculation step inside the outer loop, and replace n with i. Also maybe add a condition to limit the number of results printed, e.g. i % 100 = 0 to print every 100 iterations.
program pi
implicit none
integer :: count, n, i
real :: r, x, y
count = 0
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
IF ([condition])
r = 4 * REAL(count)/i
print *, i, r
END IF
END DO
end program pi

Program For Calculating Sin Using Taylor Expansion Not Working?

I'm trying to write some code that'll calculate the value of sin(0.75) using the Taylor expansion, and print each iteration until the absolute difference between the value calculated using the expansion, and the value calculated using Fortran's intrinsic sin function is less than 1E-6. Here is my code:
program taylor
implicit none
real :: x = 0.75
do while (x - sin(0.75) < 10**(-6))
print *, x
x = x - ((x**3)/6) + ((x**5)/120) - ((x**7)/5040)
end do
end program taylor
However, this doesn't print anything out? Why is this?
It looks too obvious to most people so no-one even wanted to answer, but it should be said explicitly
The condition x - sin(0.75) < 10**(-6) is obviously not true when x very different from sin(0.75), so the do while loop is never entered.
Also, as IanH commented 10**(-6) will give 0 because the result of the power of two integers is again an integer. The literal real number 10^-6 should be expressed as 1e-6.
If you change it to x - sin(0.75) > 1e-6 the loop will proceed, but it will run forever, because your iteration is wrong. Taylor series works differently, you should compute
y = 0
y = y + x**1/1!
y = y - x**3/3!
y = y + x**5/5!
y = y - x**7/7!
...
and so on, which is a very different kind of loop.
Try this one:
program taylor
implicit none
real :: x = 0.75
real :: y, fact
integer :: sgn, i
fact = 1
sgn = 1
y = 0
do i = 1, 10, 2
y = y + sgn * x**i / fact
fact = fact*(i+1)*(i+2)
sgn = -sgn
end do
print *, y, sin(x)
end program taylor