Accumulator within a DO loop - fortran

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.

Related

Very small number turns negative in Fortran

I'm doing a program in Fortran90 which do a sum from i=1 to i=n where nis given. The sum is sum_{i=1}^{i=n}1/(i*(i+1)*(i+2)). This sum converges to 0.25. This is the code:
PROGRAM main
INTEGER n(4)
DOUBLE PRECISION s(4)
INTEGER i
OPEN(11,FILE='input')
OPEN(12,FILE='output')
DO i=1,4
READ(11,*) n(i)
END DO
PRINT*,n
CALL suma(n,s)
PRINT*, s
END
SUBROUTINE suma(n,s)
INTEGER n(4),j,k
DOUBLE PRECISION s(4),add
s=0
DO k=1,4
DO j=1,n(k)
add=1./(j*(j+1)*(j+2))
s(k)=s(k)+add
END DO
END DO
END SUBROUTINE
input
178
1586
18232
142705
The output file is now empty, I need to code it. I'm just printing the results, which are:
0.249984481688 0.249999400246 0.248687836759 0.247565846142
The problem comes with the variable add. When j is bigger, add turns negative, and the sum doesn't converge well. How can I fix it?
The problem is an integer overflow. 142705142706142707 is a number that is too large for a 4-byte integer.
What happens then is that the number overflows and loops back to negative numbers.
As #albert said in his comment, one solution is to convert it to double precision every step of the way: ((1.d0/j) / (j+1)) / (j+2). That way, it is calculating with floating point values.
Another option would be to use 8-byte integers:
integer, parameter :: int64 = selected_int_kind(17)
integer(kind=int64) :: j
You should be very careful with your calculations, though. Finer is not always better. I recommend that you look at how floating point arithmetic is performed by a computer, and what issues this can create. See for example here on wikipedia.
This is likely a better way to achieve what you want. I did remove the IO. The output from the program is
% gfortran -o z a.f90 && ./z
178 0.249984481688392
1586 0.249999801599584
18232 0.249999998496064
142705 0.249999999975453
program main
implicit none ! Never write a program without this statement
integer, parameter :: knd = kind(1.d0) ! double precision kind
integer n(4)
real(knd) s(4)
integer i
n = [178, 1586, 18232, 142705]
call suma(n, s)
do i = 1, 4
print '(I6,F18.15)', n(i), s(i)
end do
contains
!
! Recursively, sum a(j+1) = j * a(j) / (j + 1)
!
subroutine suma(n, s)
integer, intent(in) :: n(4)
real(knd), intent(out) :: s(4)
real(knd) aj
integer j, k
s = 0
do k = 1, 4
aj = 1 / real(1 * 2 * 3, knd) ! a(1)
do j = 1, n(k)
s(k) = s(k) + aj
aj = j * aj / (j + 3)
end do
end do
end subroutine
end program main

Storing a Variable with a Multi-Dimensional Index in Fortran

Question
Consider the following code:
program example
implicit none
integer, parameter :: n_coeffs = 1000
integer, parameter :: n_indices = 5
integer :: i
real(8), dimension(n_coeffs) :: coeff
integer, dimension(n_coeffs,n_indices) :: index
do i = 1, n_coeffs
coeff(i) = real(i*3,8)
index(i,:) = [2,4,8,16,32]*i
end do
end
For any 5 dimensional index I need to obtain the associated coefficient, without knowing or calculating i. For instance, given [2,4,8,16,32] I need to obtain 3.0 without computing i.
Is there a reasonable solution, perhaps using sparse matrices, that would work for n_indices in the order of 100 (though n_coeffs still in the order of 1000)?
A Bad Solution
One solution would be to define a 5 dimensional array as in
real(8), dimension(2000,4000,8000,16000,32000) :: coeff2
do i = 1, ncoeffs
coeff2(index(i,1),index(i,2),index(i,3),index(i,4),index(i,5)) = coeff(i)
end do
then, to get the coefficient associated with [2,4,8,16,32], call
coeff2(2,4,8,16,32)
However, besides being very wasteful of memory, this solution would not allow n_indices to be set to a number higher than 7 given the limit of 7 dimensions to an array.
OBS: This question is a spin-off of this one. I have tried to ask the question more precisely having failed in the first attempt, an effort that greatly benefited from the answer of #Rodrigo_Rodrigues.
Actual Code
In case it helps here is the code for the actual problem I am trying to solve. It is an adaptive sparse grid method for approximating a function. The main goal is to make the interpolation at the and as fast as possible:
MODULE MOD_PARAMETERS
IMPLICIT NONE
SAVE
INTEGER, PARAMETER :: d = 2 ! number of dimensions
INTEGER, PARAMETER :: L_0 = 4 ! after this adaptive grid kicks in, for L <= L_0 usual sparse grid
INTEGER, PARAMETER :: L_max = 9 ! maximum level
INTEGER, PARAMETER :: bound = 0 ! 0 -> for f = 0 at boundary
! 1 -> adding grid points at boundary
! 2 -> extrapolating close to boundary
INTEGER, PARAMETER :: max_error = 1
INTEGER, PARAMETER :: L2_error = 1
INTEGER, PARAMETER :: testing_sample = 1000000
REAL(8), PARAMETER :: eps = 0.01D0 ! epsilon for adaptive grid
END MODULE MOD_PARAMETERS
PROGRAM MAIN
USE MOD_PARAMETERS
IMPLICIT NONE
INTEGER, DIMENSION(d,d) :: ident
REAL(8), DIMENSION(d) :: xd
INTEGER, DIMENSION(2*d) :: temp
INTEGER, DIMENSION(:,:), ALLOCATABLE :: grid_index, temp_grid_index, grid_index_new, J_index
REAL(8), DIMENSION(:), ALLOCATABLE :: coeff, temp_coeff, J_coeff
REAL(8) :: temp_min, temp_max, V, T, B, F, x1
INTEGER :: k, k_1, k_2, h, i, j, L, n, dd, L1, L2, dsize, count, first, repeated, add, ind
INTEGER :: time1, time2, clock_rate, clock_max
REAL(8), DIMENSION(L_max,L_max,2**(L_max),2**(L_max)) :: coeff_grid
INTEGER, DIMENSION(d) :: level, LL, ii
REAL(8), DIMENSION(testing_sample,d) :: x_rand
REAL(8), DIMENSION(testing_sample) :: interp1, interp2
! ============================================================================
! EXECUTABLE
! ============================================================================
ident = 0
DO i = 1,d
ident(i,i) = 1
ENDDO
! Initial grid point
dsize = 1
ALLOCATE(grid_index(dsize,2*d),grid_index_new(dsize,2*d))
grid_index(1,:) = 1
grid_index_new = grid_index
ALLOCATE(coeff(dsize))
xd = (/ 0.5D0, 0.5D0 /)
CALL FF(xd,coeff(1))
CALL FF(xd,coeff_grid(1,1,1,1))
L = 1
n = SIZE(grid_index_new,1)
ALLOCATE(J_index(n*2*d,2*d))
ALLOCATE(J_coeff(n*2*d))
CALL SYSTEM_CLOCK (time1,clock_rate,clock_max)
DO WHILE (L .LT. L_max)
L = L+1
n = SIZE(grid_index_new,1)
count = 0
first = 1
DEALLOCATE(J_index,J_coeff)
ALLOCATE(J_index(n*2*d,2*d))
ALLOCATE(J_coeff(n*2*d))
J_index = 0
J_coeff = 0.0D0
DO k = 1,n
DO i = 1,d
DO j = 1,2
IF ((bound .EQ. 0) .OR. (bound .EQ. 2)) THEN
temp = grid_index_new(k,:)+(/ident(i,:),ident(i,:)*(grid_index_new(k,d+i)-(-1)**j)/)
ELSEIF (bound .EQ. 1) THEN
IF (grid_index_new(k,i) .EQ. 1) THEN
temp = grid_index_new(k,:)+(/ident(i,:),ident(i,:)*(-(-1)**j)/)
ELSE
temp = grid_index_new(k,:)+(/ident(i,:),ident(i,:)*(grid_index_new(k,d+i)-(-1)**j)/)
ENDIF
ENDIF
CALL XX(d,temp(1:d),temp(d+1:2*d),xd)
temp_min = MINVAL(xd)
temp_max = MAXVAL(xd)
IF ((temp_min .GE. 0.0D0) .AND. (temp_max .LE. 1.0D0)) THEN
IF (first .EQ. 1) THEN
first = 0
count = count+1
J_index(count,:) = temp
V = 0.0D0
DO k_1 = 1,SIZE(grid_index,1)
T = 1.0D0
DO k_2 = 1,d
CALL XX(1,temp(k_2),temp(d+k_2),x1)
CALL BASE(x1,grid_index(k_1,k_2),grid_index(k_1,k_2+d),B)
T = T*B
ENDDO
V = V+coeff(k_1)*T
ENDDO
CALL FF(xd,F)
J_coeff(count) = F-V
ELSE
repeated = 0
DO h = 1,count
IF (SUM(ABS(J_index(h,:)-temp)) .EQ. 0) THEN
repeated = 1
ENDIF
ENDDO
IF (repeated .EQ. 0) THEN
count = count+1
J_index(count,:) = temp
V = 0.0D0
DO k_1 = 1,SIZE(grid_index,1)
T = 1.0D0
DO k_2 = 1,d
CALL XX(1,temp(k_2),temp(d+k_2),x1)
CALL BASE(x1,grid_index(k_1,k_2),grid_index(k_1,k_2+d),B)
T = T*B
ENDDO
V = V+coeff(k_1)*T
ENDDO
CALL FF(xd,F)
J_coeff(count) = F-V
ENDIF
ENDIF
ENDIF
ENDDO
ENDDO
ENDDO
ALLOCATE(temp_grid_index(dsize,2*d))
ALLOCATE(temp_coeff(dsize))
temp_grid_index = grid_index
temp_coeff = coeff
DEALLOCATE(grid_index,coeff)
ALLOCATE(grid_index(dsize+count,2*d))
ALLOCATE(coeff(dsize+count))
grid_index(1:dsize,:) = temp_grid_index
coeff(1:dsize) = temp_coeff
DEALLOCATE(temp_grid_index,temp_coeff)
grid_index(dsize+1:dsize+count,:) = J_index(1:count,:)
coeff(dsize+1:dsize+count) = J_coeff(1:count)
dsize = dsize + count
DO i = 1,count
coeff_grid(J_index(i,1),J_index(i,2),J_index(i,3),J_index(i,4)) = J_coeff(i)
ENDDO
IF (L .LE. L_0) THEN
DEALLOCATE(grid_index_new)
ALLOCATE(grid_index_new(count,2*d))
grid_index_new = J_index(1:count,:)
ELSE
add = 0
DO h = 1,count
IF (ABS(J_coeff(h)) .GT. eps) THEN
add = add + 1
J_index(add,:) = J_index(h,:)
ENDIF
ENDDO
DEALLOCATE(grid_index_new)
ALLOCATE(grid_index_new(add,2*d))
grid_index_new = J_index(1:add,:)
ENDIF
ENDDO
CALL SYSTEM_CLOCK (time2,clock_rate,clock_max)
PRINT *, 'Elapsed real time1 = ', DBLE(time2-time1)/DBLE(clock_rate)
PRINT *, 'Grid Points = ', SIZE(grid_index,1)
! ============================================================================
! Compute interpolated values:
! ============================================================================
CALL RANDOM_NUMBER(x_rand)
CALL SYSTEM_CLOCK (time1,clock_rate,clock_max)
DO i = 1,testing_sample
V = 0.0D0
DO L1=1,L_max
DO L2=1,L_max
IF (L1+L2 .LE. L_max+1) THEN
level = (/L1,L2/)
T = 1.0D0
DO dd = 1,d
T = T*(1.0D0-ABS(x_rand(i,dd)/2.0D0**(-DBLE(level(dd)))-DBLE(2*FLOOR(x_rand(i,dd)*2.0D0**DBLE(level(dd)-1))+1)))
ENDDO
V = V + coeff_grid(L1,L2,2*FLOOR(x_rand(i,1)*2.0D0**DBLE(L1-1))+1,2*FLOOR(x_rand(i,2)*2.0D0**DBLE(L2-1))+1)*T
ENDIF
ENDDO
ENDDO
interp2(i) = V
ENDDO
CALL SYSTEM_CLOCK (time2,clock_rate,clock_max)
PRINT *, 'Elapsed real time2 = ', DBLE(time2-time1)/DBLE(clock_rate)
END PROGRAM
For any 5 dimensional index I need to obtain the associated
coefficient, without knowing or calculating i. For instance, given
[2,4,8,16,32] I need to obtain 3.0 without computing i.
function findloc_vector(matrix, vector) result(out)
integer, intent(in) :: matrix(:, :)
integer, intent(in) :: vector(size(matrix, dim=2))
integer :: out, i
do i = 1, size(matrix, dim=1)
if (all(matrix(i, :) == vector)) then
out = i
return
end if
end do
stop "No match for this vector"
end
And that's how you use it:
print*, coeff(findloc_vector(index, [2,4,8,16,32])) ! outputs 3.0
I must confess I was reluctant to post this code because, even though this answers your question, I honestly think this is not what you really want/need, but you dind't provide enough information for me to know what you really do want/need.
Edit (After actual code from OP):
If I decrypted your code correctly (and considering what you said in your previous question), you are declaring:
REAL(8), DIMENSION(L_max,L_max,2**(L_max),2**(L_max)) :: coeff_grid
(where L_max = 9, so size(coeff_grid) = 21233664 =~160MB) and then populating it with:
DO i = 1,count
coeff_grid(J_index(i,1),J_index(i,2),J_index(i,3),J_index(i,4)) = J_coeff(i)
ENDDO
(where count is of the order of 1000, i.e. 0.005% of its elements), so this way you can fetch the values by its 4 indices with the array notation.
Please, don't do that. You don't need a sparse matrix in this case either. The new approach you proposed is much better: storing the indices in each row of an smaller array, and fetching on the array of coefficients by the corresponding location of those indices in its own array. This is way faster (avoiding the large allocation) and much more memory-efficient.
PS: Is it mandatory for you to stick to Fortran 90? Its a very old version of the standard and chances are that the compiler you're using implements a more recent version. You could improve the quality of your code a lot with the intrinsic move_alloc (for less array copies), the kind constants from the intrinsic module iso_fortran_env (for portability), the [], >, <, <=,... notation (for readability)...

How to exit from nested Fortran loops?

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

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

Nesting errors in FORTRAN

I'm creating a program that is required to read values from two arrays (ARR and MRK), counting each set of values (I,J) in order to determine their frequency for a third array (X). I've written the following so far, but nesting errors are preventing the program from compiling. Any help is greatly appreciated!
IMPLICIT NONE
REAL, DIMENSION (0:51, 0:51) :: MRK, ALT
INTEGER :: I, J !! FREQUENCY ARRAY ALLELES
INTEGER, PARAMETER :: K = 2
INTEGER :: M, N !! HAPLOTYPE ARRAY POSITIONS
INTEGER :: COUNTER = 0
REAL, DIMENSION(0:1,0:K-1):: X
ALT = 8
MRK = 8
X = 0
MRK(1:50,1:50) = 0 !! HAPLOTYPE ARRAY WITHOUT BUFFER AROUND OUTSIDE
ALT(1:50,1:50) = 0
DO I = 0, 1 !! ALTRUIST ALLELE
DO J = 0, K-1 !! MARKER ALLELE
DO M = 1, 50
DO N = 1, 50 !! READING HAPLOTYPE POSITIONS
IF ALT(M,N) = I .AND. MRK(M,N) = J THEN
COUNTER = COUNTER + 1
ELSE IF ALT(M,N) .NE. I .OR. MRK(M,N) .NE. J THEN
COUNTER = COUNTER + 0
END IF
X(I,J) = COUNTER/2500
COUNTER = 0
END DO
END DO
END DO
END DO
Your if syntax is incorrect. You should enclose the conditional expressions between brackets. Also, I think you should replace single = by a double == in the same expressions and maybe keep the syntax type to either == and /= or .eq. and .neq., but not mix them:
IF (ALT(M,N) == I .AND. MRK(M,N) == J) THEN
COUNTER = COUNTER + 1
ELSE IF (ALT(M,N) /= I .OR. MRK(M,N) /= J) THEN
COUNTER = COUNTER + 0
END IF
I don't know if in your actual program you do it, but you should probably use program program_name and end program program_name at the very beginning and very end of your code, respectively, where program_name is anything you want to call your program (no spaces allowed I think), although a simple end at the end would suffice.