Related
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
I want to solve the Random Walk problem, so i wrote a fortran sequental code and now i need to parallel this code.
subroutine random_walk(walkers)
implicit none
include "omp_lib.h"
integer :: i, j, col, row, walkers,m,n,iter
real, dimension(:, :), allocatable :: matrix, res
real :: point, z
col = 12
row = 12
allocate (matrix(row, col), res(row, col))
! Read from file
open(2, file='matrix.txt')
do i = 1, row
read(2, *)(matrix(i, j), j=1,col)
end do
res = matrix
! Solve task
!$omp parallel private(i,j,m,n,point,iter)
!$omp do collapse(2)
do i= 2, 11
do j=2, 11
m = i
n = j
iter = 1
point = 0
do while (iter <= walkers)
call random_number(z)
if (z <= 0.25) m = m - 1
if (z > 0.25 .and. z <= 0.5) n = n +1
if (z > 0.5 .and. z <= 0.75) m = m +1
if (z > 0.75) n = n - 1
if (m == 1 .or. m == 12 .or. n == 1 .or. n == 12) then
point = point + matrix(m, n)
m = i
n = j
iter = iter + 1
end if
end do
point = point / walkers
res(i, j) = point
end do
end do
!$omp end do
!$omp end parallel
! Write to file
open(2, file='out_omp.txt')
do i = 1, row
write(2, *)(res(i, j), j=1,col)
end do
contains
end
So, the problem is that parallel program computes MUCH lesser than its sequential version.
Where is the mistake?(except my terrible code)
Update: for now the code is with !$omp do directives, but the result is still the same: it is much lesser than its sequential version.
Most probably, the behavior is related to the random number extraction. RANDOM_NUMBER Fortran procedure is not even guaranteed to be thread-safe but it is thread-safe at least in GNU compiler thanks to a GNU extension. But in any case the performances seem to be very bad as you note.
If you switch to a different thread-safe random number generator, the scalability of your code can be good. I used the classical ran2.f generator:
http://www-star.st-and.ac.uk/~kw25/research/montecarlo/ran2.f
modified to make it thread-safe. If I am not wrong, to do that:
in the calling unit declare and define:
integer :: iv(32), iy, idum2, idum
idum2 = 123456789 ; iv(:) = 0 ; iy = 0
in OpenMP directives add idum as private and idum2, iv, iy as firstprivate (by the way you need to add z as private too)
in the parallel section add (before do)
idum = - omp_get_thread_num()
to have different random numbers for different threads
from ran2 function remove DATA and SAVE lines e pass idum2, iv, iy as arguments:
FUNCTION ran2(idum, iv, iy, idum2)
call ran2 instead of random_number intrinsic
z = ran2(idum, iv, iy, idum2)
With walkers=100000 (GNU compiler) these are my times:
1 thread => 4.7s
2 threads => 2.4s
4 threads => 1.5s
8 threads => 0.78s
16 threads => 0.49s
Not strictly related to the question but I have to say that extracting a real number for each 4 "bit"s info you need (+1 or -1) and the usage of conditionals can be probably changed using a more efficient strategy.
The program is as follows.
The issue occurs when I try to run the code for >~80 years, at which point the code apparently 'runs' instantly, generating an empty text file. The code runs fine for smaller timescales.
PROGRAM NBody
IMPLICIT NONE
DOUBLE PRECISION:: m(1:10), deltaR(1:3)
DOUBLE PRECISION:: G, r
DOUBLE PRECISION, DIMENSION(10,3):: pos, v, a0, a1 !x, y, z
INTEGER:: n,i,j,k,stepsize, year, zero, length
CHARACTER(len=13):: fname !xxxyrxxpl.txt
zero = 0
m(1) = 1988500e24 !sun
m(2) = 0.33e24 !mercury
m(3) = 4.87e24 !venus
m(4) = 5.97e24 !earth
m(5) = 0.642e24 !mars
m(6) = 1898e24 !jupiter
m(7) = 568e24 !saturn
m(8) = 86.8e24 !uranus
m(9) = 102e24 !!neptune
m(10) = 0.0146e24 !pluto
!Initial POS
pos = zero
pos(2,1) = 57.9e9
pos(3,1) = 108e9
pos(4,1) = 149e9
pos(5,1) = 227e9
pos(6,1) = 778e9
pos(7,1) = 1352.6e9
pos(8,1) = 2741.3e9
pos(9,1) = 4444.5e9
pos(10,1) = 4436.8e9
!FORTRAN works column,row: (particle,x/y/z)
!Momentum is initially non-zero due to planet and velocity starting points. Figure out a solution.
!Initial velocity
v = zero
v(2,2) = 47.4e3
v(3,2) = 35e3
v(4,2) = 29.8e3
v(5,2) = 24.1e3
v(6,2) = 13.1e3
v(7,2) = 9.7e3
v(8,2) = 6.8e3
v(9,2) = 5.4e3
v(10,2) = 4.7e3
g = 6.67e-11
stepsize = 1800 !3600 = 1 hour
year = 3.154e+7
!Calculate initial values
a0 = 0
a1 = 0
do i = 1,10
do j = 1,10
if(i==j) cycle
deltaR(:) = (pos(i,:)-pos(j,:))
r = -sqrt((pos(i,1)-pos(j,1))**2+(pos(i,2)-pos(j,2))**2+(pos(i,3)-pos(j,3))**2)
a0(i,:) = a0(i,:) + g*M(j)*deltaR*r**(-3)
END DO
END DO
write(6,*) "Specify length in years"
read (*,*) length
write(6,*) "Specify file name (xxxYRzzPL.txt)"
read(*,*) fname
!Just above is where I call for a length in the terminal, values of 40 will work, much higher do not. I don't know the exact cut-off.
open (unit = 2, file = fname)
!Do loop over time, planet and partners to step positions
do k=0, length*year,stepsize
write(2,*) pos
pos = pos + v*stepsize + 0.5*a0*stepsize**2
do i = 1,10
do j = 1,10
if(i==j) cycle
deltaR(:) = (pos(i,:)-pos(j,:))
r = -sqrt((pos(i,1)-pos(j,1))**2+(pos(i,2)-pos(j,2))**2+(pos(i,3)-pos(j,3))**2)
a1(i,:) = a1(i,:) + G*M(j)*deltaR/r**3
END DO
END DO
v = v + 0.5*(a0+a1)*stepsize
a0=a1
a1=0
END DO
close (2)
END PROGRAM
I suspected it could be an issue with variable storage but I can't see any problems there.
Using an iterator like this can be dubious. Even an 8 byte integer will overflow if you go long enough. Considering how this code is set up, I would do something like this:
do iYear = 1, length
do k = 0, year, stepsize
....
enddo
enddo
Inner do loop loops over one year. Outer do loop loops over the years. Could go Gigayears like this with just 4 byte integers if you want to wait that long.
I would likely rename your variables too to make more sense. This would look better:
do iYear = 1, nYears
do k = 0, YearLength, stepsize
....
enddo
enddo
Expanding on #francescalus, you may need to specify your integers as 8-bytes rather than the default 4:
integer, parameter :: c_int8 = selected_int_kind (10)
integer(kind = c_int8) :: n,i,j,k,stepsize, year, zero, length
EDIT I added a parameter to determine the correct value for a 64-bit integer intrinsically.
My goal is to create 10,000 randomly generated numbers between 0 and 1, organize them into ten bins evenly spaced between 0 and 1, and compute a frequency for each bin. This is my code so far.
program listrand
implicit none
integer :: n,p
integer :: a,b,c,d,e,f,g,h,i,j = 0
real :: xran
!real, dimension(10,2) :: bin_and_freq -- list of bins and frequency
do n = 1,10000
call random_number(xran)
if (xran < 0.1) then
a = a + 1
elseif (xran>0.1 .and. xran<0.2) then
b = b + 1
elseif (xran>0.2 .and. xran<0.3) then
c = c+1
elseif (xran>0.3 .and. xran<0.4) then
d = d+1
elseif (xran>0.4 .and. xran<0.5) then
e = e + 1
elseif (xran>0.5 .and. xran<0.6) then
f = f+1
elseif (xran>0.6 .and. xran<0.7) then
g = g+1
elseif (xran>0.7 .and. xran<0.8) then
h=h+1
elseif (xran>0.8 .and. xran<0.9) then
i=i+1
else
j = j+1
endif
enddo
print *, a,b,c,d,e,f,g,h,i,j
end program listrand
I am getting an unexpected output:
988 1036 133225987 1004 934 986 1040 33770 1406729616 1052.
Why are c,h, and i so large? Also, is there a more efficient way of going about this than using the unwieldy IF/ELSEIF block I have?
In your long
integer :: a,b,c,d,e,f,g,h,i,j = 0
You are only initialising j to be 0, all others have random numbers in them. If you add
a = 0
b = 0
c = 0
d = 0
e = 0
f = 0
g = 0
h = 0
i = 0
j = 0
before your loop, everything works well.
As for how to simplify it:
Here is my version of the program:
program listrand
implicit none
integer, parameter :: nbins = 10
integer :: n, bin
integer :: bin_hits(nbins) ! Number of bin hits
real :: xran
real :: bin_lower(nbins) ! Lower edge of bins
! bin_lower(1) == 0.0
bin_hits = 0
! Set up equidistant bins
bin_lower = [ (real(n-1) / nbins, n = 1, size(bin_lower)) ]
do n = 1,10000
call random_number(xran)
bin = count(bin_lower <= xran)
bin_hits(bin) = bin_hits(bin)+1
enddo
do n = 1, nbins-1
print '(2(F6.2), I6)' bin_lower(n), bin_lower(n+1), bin_hits(n)
end do
print '(2(F6.2), I6)' bin_lower(nbins), 1.0, bin_hits(nbins)
end program listrand
For the index of which bin_hits element to increment, I'm counting the number of values in bin_lower that are actually lower than xran.
EDIT
I'd like to also point to the answer from High Performance Mark a bit further down, who instead of calling RANDOM_NUMBER for each value individually uses it to generate a whole array of random numbers.
Additionally, he's using the fact that the bins are fixed and equidistant to calculate the bin number directly from the random value instead of comparing it to each bin as in my version.
Both of these make the program faster.
If speed of execution is one's main concern, and if one is willing to trade space for time, this might appeal:
PROGRAM listrand
IMPLICIT NONE
INTEGER, PARAMETER :: nbins = 10
INTEGER, PARAMETER :: nsamples = 10**4
INTEGER :: bin_hits(0:nbins-1)
REAL :: xran(nsamples)
INTEGER :: binned_rn(nsamples), n
bin_hits = 0
CALL RANDOM_NUMBER(xran)
binned_rn = INT(nbins*xran)
DO n = 1, nsamples
bin_hits(binned_rn(n)) = bin_hits(binned_rn(n)) +1
END DO
WRITE(*,*) bin_hits
END PROGRAM listrand
In a limited number of tests this version is 3 - 4 times as fast as #chw21's version.
I'm trying to write a program (in Fortran 95) that finds the minimal decomposition of natural numbers up to N into a sum of at most 4 positive integers.
I've been trying to add and remove statements for a while to make it stop at only the minimal decomposition but I'm not getting anywhere. How do I make the program stop as soon as it's found the minimal decomposition?
PROGRAM SummeQuadrat
IMPLICIT NONE
real:: start,finish
integer:: a,b,c,d,g,x,y
write(*,*) "Max n"
read (*,*) y
call cpu_time(start)
do x=1,y,1
do a=0,x,1
do b=a,x-a,1
do c=b,x-b,1
do d=c,x-c,1
if (a**2+b**2+c**2+d**2 .eq. x) then
write(*,*) "x=",x,d,c,b,a
end if
end do
end do
end do
end do
end do
call cpu_time(finish)
write(*,*)finish-start
end program SummeQuadrat
As I explained in the comments, I am not sure you are asking only how to break out of the loops or for more.
You can jump out of any loop using the EXIT statement. To exit from a loop which is not the innermost loop you are currently in you use a labeled loop and use the label in the EXIT statement to exit that particular loop.
outer: do x = 1, y
do a = 0, x
do b = a, x-a
do c = b, x-b
do d = c, x-c
if (a**2+b**2+c**2+d**2 == x) then
write(*,*) "x=",x,d,c,b,a
if (minimal(a,b,c,d)) exit outer
end if
end do
end do
end do
end do
end do outer
Old thread, but it's kind of a fun problem so I thought I might post my own interpretation.
First off, if we cheat a little and peek at the solution it can be seen that all 4 squares are only needed when x=4**k*(8*m+7). Thus we can search cheaply for 1 or 2 square solutions and on failure decide by the above criterion whether to search for a 3- or 4-square solution.
Then when we structure our loops, count down from the largest a such that a**2 <= x, then the largest b <= a such that a**2+b**2 <= x and so on. This takes the problem from O(x**4) down to O(x**1.5) so it can go much quicker.
For output format, by judicious use of the colon format we can write a single format that prints out results in perhaps a more readable fashion.
! squares.f90 -- Prints out minimal decomposition x into squares
! for 1 <= x <= y (user input)
program squares
use ISO_FORTRAN_ENV, only: REAL64
implicit none
! Need this constant so we can take the square root of an
! integer.
real(REAL64), parameter :: half = 0.5_REAL64
real start, finish
integer a,b,c
integer amax,bmax,cmax,dmax
integer amin,bmin,cmin
integer x,y
! Format for printing out decomposition into squares
character(40) :: fmt = '(i0," = ",i0"**2":3(" + ",i0,"**2":))'
integer nzero
! Get uper bound from user
write(*,'(a)',advance='no') 'Please enter the max N:> '
read(*,*) y
call cpu_time(start)
! Loop over requested range
outer: do x = 1, y
amax = sqrt(x+half)
! Check for perfect square
if(amax**2 == x) then
write(*,fmt) x,amax
cycle outer
end if
! Check for sum of 2 squares
amin = sqrt(x/2+half)
try2: do a = amax, amin, -1
bmax = sqrt(x-a**2+half)
if(bmax > a) exit try2
if(a**2+bmax**2 == x) then
write(*,fmt) x,a,bmax
cycle outer
end if
end do try2
! If trailz(x) is even, then x = 4**k*z, where z is odd
! If further z = 8*m+7, then 4 squares are required, otherwise
! only 3 should suffice.
nzero = trailz(x)
if(iand(nzero,1)==0 .AND. ibits(x,nzero,3)==7) then
amin = sqrt(x/4+half)
do a = amax, amin, -1
bmax = sqrt(x-a**2+half)
bmin = sqrt((x-a**2)/3+half)
do b = min(bmax,a), bmin, -1
cmax = sqrt(x-a**2-b**2+half)
cmin = sqrt((x-a**2-b**2)/2+half)
do c = min(cmax,b), cmin, -1
dmax = sqrt(x-a**2-b**2-c**2+half)
if(a**2+b**2+c**2+dmax**2 == x) then
write(*,fmt) x,a,b,c,dmax
cycle outer
end if
end do
end do
end do
else
amin = sqrt(x/3+half)
do a = amax, amin, -1
bmax = sqrt(x-a**2+half)
bmin = sqrt((x-a**2)/2+half)
do b = min(bmax,a), bmin, -1
cmax = sqrt(x-a**2-b**2+half)
if(a**2+b**2+cmax**2 == x) then
write(*,fmt) x,a,b,cmax
cycle outer
end if
end do
end do
end if
! We should have a solution by now. If not, print out
! an error message and abort.
write(*,'(*(g0))') 'Failure at x = ',x
stop
end do outer
call cpu_time(finish)
write(*,'(*(g0))') 'CPU time = ',finish-start
end program squares