FORTRAN 77 'Error: Unclassifiable statement at (1)' - fortran

I'm a Fortran 77 learner, I'm new so don'n know much about Fortran.
Our professor gave us a homework. We suppose to write a program that calculates cos(x**2).
It has a Taylor expansion, so I tried to write some things but It gave me this error:
term = term*((-1)**i)*x**2*i)/fac(2*i)
1
Error: Unclassifiable statement at (1)
The hole program is:
PROGRAM COSX_SQUARE
IMPLICIT NONE
INTEGER x, n, i
REAL partial_sum, term
20 PRINT*, 'INPUT THE DEGREE'
READ*, x
x = x*180/3.1415
PRINT*, 'INPUT THE CORRECTION VALUE '
PRINT*, 'AS A NATURAL NUMBER'
READ*, n
i= -1
term = 1
partial_sum = term
10 i=i+1
term = term*((-1)**i)*x**2*i)/fac(2*i)
partial_sum = partial_sum + term
IF (i .LT. n) THEN
GO TO 10
ELSE
PRINT*, 'COS', x, 'SQUARE IS = ', partial_sum
END IF
GO TO 20
END
Where am I mistaking? And will this program work well? Thanks in advance.

You are missing one bracket in your expression!
It should probably read:
term = term*(((-1)**i)*x**2*i)/fac(2*i)

Related

alternatives of using real as array index

I wish to solve the schrodinger time dependent equation . In my code, I introduced two arrays, namely yc and yr, for the complex and real part of wavefunction . Later I tried to store the values in the array in the format yc(x(i),t(j)) as y(x,t) function .There is a warning showing that I am using real as index of an array . I understand where the problem lies, but what is the way out ? Can I define a function whose values I can assign during my program discreetly as an alternative to that array ?
I have googled about this could not find any solution .
function v(x) result(s)
real::s,x
if (x<0) then
s=0
else
s=1
end if
end function v
real::t(10000),x(10000),yc(10000,10000),yr(10000,10000),tf,xi,xf,d
integer::i,j,k,l,m
write(*,*) "tf,xi,xf,step size"
read(*,*) tf,xi,xf,d
x(1)=xi
t(1)=0
i=1
1 if(x(i).lt.xf) then
x(i+1)=x(i)+d
i=i+1
goto 1
end if
do j=1,i
yr(x(j),0)=exp(-x(j)**2) !initial wavefunction
yc(x(j),0)=0
end do
do l=1,i
k=1
3 if(t(k).lt.tf) then
yr(x(l),t(k+1))=yr(x(l),t(k))-(yc(x(l)+2*d,t(k))-2*yc(x(l)+d,t(k))+yc(x(l),t(k)))/d&
+v(x(l))*yc(x(l),t(k))*d
yc(x(l),t(k+1))=yc(x(l),t(k))+(yr(x(l)+2*d,t(k))-2*yr(x(l)+d,t(k))+yr(x(l),t(k)))/d&
-v(x(l))*yr(x(l),t(k))*d
k=k+1
goto 3
end if
end do
open(1,file="q.dat")
do m=1,i
write(1,*) x(m),yr(x(m),t(1))**2+yc(x(m),t(1))**2
end do
close(1)
end
expected result :$ yi(x,t)^2+yc(x,t)^2 versus x at different t
obtained error :
yr(x(j),0)=exp(-x(j)**2) !initial wavefunction
1
Warning: Legacy Extension: REAL array index at (1)
schrodinger.f90:27:8:
yr(x(j),0)=exp(-x(j)**2) !initial wavefunction
1
Warning: Array reference at (1) is out of bounds (0 < 1) in dimension 2
schrodinger.f90:28:3: and so on`enter code here`
I have googled how to use real as index but no use .
function v(x) result(s)
real::s,x
if (x<0) then
s=0
else
s=1
end if
end function v
real::t(10000),x(10000),yc(10000,10000),yr(10000,10000),tf,xi,xf,d
integer::i,j,k,l,m
write(*,*) "tf,xi,xf,step size"
read(*,*) tf,xi,xf,d
x(1)=xi
t(1)=0
i=1
1 if(x(i).lt.xf) then
x(i+1)=x(i)+d
i=i+1
goto 1
end if
do j=1,i
yr(x(j),0)=exp(-x(j)**2) !initial wavefunction
yc(x(j),0)=0
end do
do l=1,i
k=1
3 if(t(k).lt.tf) then
yr(x(l),t(k+1))=yr(x(l),t(k))-(yc(x(l)+2*d,t(k))-2*yc(x(l)+d,t(k))+yc(x(l),t(k)))/d&
+v(x(l))*yc(x(l),t(k))*d
yc(x(l),t(k+1))=yc(x(l),t(k))+(yr(x(l)+2*d,t(k))-2*yr(x(l)+d,t(k))+yr(x(l),t(k)))/d&
-v(x(l))*yr(x(l),t(k))*d
k=k+1
goto 3
end if
end do
open(1,file="q.dat")
do m=1,i
write(1,*) x(m),yr(x(m),t(1))**2+yc(x(m),t(1))**2
end do
close(1)
end
expected : data files with wavefunction at different time .
obtained : warning - using real as indices
Just reference your arrays using the integers i,j etc. If you have x(i),t(j) then yr(i,j) is the corresponding value. To get the offsets of +2*d etc you only need to use use +2 instead. e.g. yr(l+2,k) rather than yr(x(l)+2*d,t(k)).
Also, please use implicit none for a start and get a hold of a modern Fortran reference book or similar. All those go tos are a bit hard on the eyes.

Compiler won't calculate variable unless I print it""

So apparently, depending in wether i tell the program to print the variable i, or not, I get different results that should not have anything to do with wether i print it our or not.
PROGRAM hello
IMPLICIT NONE
integer :: n,i, mini
logical :: leave = .false.
read*, n
print*, is_prime(n)
!!---------------------------------------------------------------------
do i=n, n/2, -1
print*, "I= ", i !!if you comment out this line, the result will be different than if you were to keep it, try it out yourselves
if(is_prime(i)) then
mini = i
end if
end do
print*, "the lowest prime number between your number and its half is: ", mini
!!----------------------------------------------------------
CONTAINS
logical function is_prime(n)
integer::n,i
do i=2,n
if(mod(n,i) == 0 .and. (i/=1 .and. i/=n) ) then
is_prime = .false.
elseif(mod(n,i) /=0 .and. i == n-1 .and. is_prime .neqv. .false.) then
is_prime = .true.
end if
end do
return
end function
END PROGRAM
So if you were to comment out the line I pointed out, the result of "mini" will be different than if you were to keep it, as I said.
I'm fairly new at fortran so I don't know wether I'm doing something wrong, or if this has something to do with the compiler, but it seems really weird to me that putting a print*, line would in any way change the value of the variabe, and that's what seems to happen.
For example if you try it yourselve, the output of mini when the print line is in, is for exaple,, typing in 48, is 29, which is right, it's the minimum prime number between 48 and ts half, but when you tipe in 48 and the famous print line is commented out, the output will be -2, instead of 29.
Any of you know why this happenes?
#francescalus is right, the logic of is_prime is wrong.
You can tell by checking the first result (the print *, is_prime(n)) of the program.
Below, a version with a correct is_prime. I first assign .true. to the result and invalidate it to .false. when the test is true.
PROGRAM hello
IMPLICIT NONE
integer :: n,i, mini
read*, n
print*, is_prime(n)
!!---------------------------------------------------------------------
do i=n, n/2, -1
print*, "I= ", i
if(is_prime(i)) then
mini = i
end if
end do
print*, "the lowest prime number between your number and its half is: ", mini
!!----------------------------------------------------------
CONTAINS
logical function is_prime(n)
integer, intent(in) :: n
integer :: i
is_prime = .true.
do i=2,n
if(mod(n,i) == 0 .and. (i/=1 .and. i/=n) ) then
is_prime = .false.
end if
end do
end function is_prime
END PROGRAM
EDIT: I should add that the issue with the influence of the print statement comes up from time to time. When it arises, it points to a flaw in the logic of the code that then becomes sensitive to situations of ill-defined results.

How can I create code for specific variable?

I want to embed a code for Fortran 95.
For example: I have read an integer variable
read *, x
for instance x=4. and my source creates four loop which has four loop variable
loop1:do a=1,16
loop2:do b=1,16
loop3:do c=1,16
loop4:do d=1,16
........smt......
end do loop4
end do loop3
end do loop2
end do loop1
I'm working on a such a code that tries for finding a magic square. I can find a magic code by using a algorithm for odd numbered square matrices. probably, I also can generate a magic square which is even numbered and double-even numbered. however , I'm trying to improve my coding skills by writing a program that tries element by element to find magic square.
implicit integer (a-z)
counte=possibility counter , magcon=magic square generated counter
god and devil are logical variables. But I used them as integer.
integer GG(3,3),COUNTE,magcon
integer god,devil
open(55,file='mymagics')
COUNTE=0
magcon=0
loop1:do a=9,1,-1
loop2:do b=9,1,-1
loop3:do c=9,1,-1
loop4:do d=9,1,-1
loop5:do e=9,1,-1
loop6:do f=9,1,-1
loop7:do g=9,1,-1
loop8:do h=9,1,-1
loop9:do i=9,1,-1
these loops are for evaluating elements
GG(1,1)=a
GG(1,2)=b
GG(1,3)=c
GG(2,1)=d
GG(2,2)=e
GG(2,3)=f
GG(3,1)=g
GG(3,2)=h
GG(3,3)=i
call elementcontrol(gg,devil)
if(devil.eq.1)then
call magiccontrol(GG,god)
else if(devil.eq.0) then
cycle
endif
COUNTE=COUNTE+1
if(allah.eq.1) then
magcon=magcon+1
write(55,66)
write(55,*) counte ,"possibility is tried"
write(55,*)"**************************************"
write(55,*)"**************************************"
write(55,*)"**************************************"
write(55,*)"--------------------------------------"
write(55,*)GG(1,1),GG(1,2),GG(1,3)
write(55,*)GG(2,1),GG(2,2),GG(2,3)
write(55,*)GG(3,1),GG(3,2),GG(3,3)
write(55,*)"--------------------------------------"
write(55,*)"**************************************"
write(55,*)"**************************************"
write(55,*)"**************************************"
write(55,66)
66 format(//)
else
print *, counte ,"possibility is unvalid"
end if
enddo loop9
enddo loop8
enddo loop7
enddo loop6
enddo loop5
enddo loop4
enddo loop3
enddo loop2
enddo loop1
print *, "finally done!"
print *, magcon,"magic square is found"
stop
end
subroutine magiccontrol(magic,logic)
integer logic,z
integer magic(3,3),sumrow(3),sumcol(3),sumdia(2)
these are row,column and diagonal sum finder
do z=1,3
sumrow(z)=0
sumcol(z)=0
sumdia(z)=0
end do
do 31 k=1,3
do 31 l=1,3
sumrow(k)=sumrow(k)+(magic(k,l))
31 continue
do 52 m=1,3
do 52 n=1,3
sumcol(m)=sumcol(m)+(magic(n,m))
52 continue
do 69 i=1,3
sumdia(1)=sumdia(1)+magic(i,i)
sumdia(2)=sumdia(2)+magic((4-i),i)
69 continue
loop1:do y=1,3
loop2:do f=1,3
loop3:do x=1,2
if(sumrow(y).eq.15) then
if(sumcol(f).eq.15)then
if(sumdia(x).eq.15)then
logic=1
else
logic=0
exit loop1
end if
else
logic=0
exit loop1
end if
else
logic=0
exit loop1
end if
end do loop3
end do loop2
end do loop1
15 is magic constant. loops are for evaluate whether a aquare is magic or not.
end
subroutine elementcontrol(elecon,logic2)
integer elecon(3,3),a1,a2,a3,a4,a5,a6,coun(9)
do a4=1,9
coun(a4)=0
end do
logic2=0
do a1=1,9
do a2=1,3
do a3=1,3
if(a1.eq.elecon(a2,a3))then
coun(a1)=coun(a1)+1
end if
end do
end do
end do
do a5=1,9
do a6=1,9
if(a5.ne.a6) then
if(coun(a5).eq.coun(a6)) then
logic2=1
else
logic2=0
exit
end if
else
cycle
end if
end do
end do
there loops are to evaluate whether every element is different from each other or not.
end
Now the problem is that if I will be inclined to increase number of rows and columns of magic square, I have to rewrite element specifier loops. But I'm not willing to that. So I want to declare a variable,read it , and be able to make program create do loops as read.
I wish I was crystal clear about what I want to know.
The test could look something like this:
LOGICAL FUNCTION IsMagical(dim_o_square, SquareData)
IMPLICIT NONE
INTEGER , INTENT(IN ) :: Dim_o_Square
REAL, DIMENSION(Dim_o_Square, Dim_o_Square), INTENT(IN ) :: SquareData
REAL, DIMENSION(Dim_o_Square) :: Row_Sum, Col_Sum
REAL :: Diag_Sum
IsMagical = .FALSE.
INTEGER :: I
IF(Dim_o_Square < 2) THEN
WRITE(*,*) '[SubMagic?:line10] DIMENSION of square is hosed'
RETURN
ENDIF
! Fill the data to determine PFM'ness
DIAG = 0
DO I = 1, Dim_o_Square
COL_Sum(I) = SUM(SquareData(:,I))
ROW_Sum(I) = SUM(SquareData(I,:))
DIAG_Sum = Diag + SquareData(I,I)
ENDDO
! Test for PFM'ness
DO I = 2, Dim_o_Square
IF( COL(I) /= Diag .OR. ROW(I) /= Diag ) THEN
RETURN
ENDIF
ENDDO
!Must be magical at this point...
IsMagical = .TRUE.
WRITE(*,*) '[SubMagic?:line40] Magical and sum value (Row/Col/Diag)=', DIAG_Sum
RETURN
END FUNCTION IsMagical
Perhaps there is some carry over in concepts for producing the square?

Compiling Fortran IV code with Fortran 77 compiler

I have a code in Fortran IV that I need to run. I was told to try to compile it in Fortran 77 and fix the error. So I named the file with a .f extension and tried to compile it with gfortran. I got the next error referring to the Fortran IV function copied below:
abel.f:432.24:
REAL FUNCTION DGDT*8(IX,NV,XNG,FNG,GNG,X)
1
Error: Expected formal argument list in function definition at (1)
Since I'm not too familiar with Fortran I'd appreciate if someone can tell me how to fix this problem .
REAL FUNCTION DGDT*8(IX,NV,XNG,FNG,GNG,X) AAOK0429
C AAOK0430
C THIS SUBROUTINE COMPUTES THE VALUE OF THE DERIVATIVE OF THE AAOK0431
C G-FUNCTION FOR A SLIT TRANSMISSION FUNCTION GIVEN BY A AAOK0432
C PIECE-WISE CUBIC SPLINE , WHOSE PARAMETERS ARE AAOK0433
C CONTAINED IN XNG,FNG AND GNG. AAOK0434
C AAOK0435
IMPLICIT REAL*8(A-H,O-Z) AAOK0436
C AAOK0437
C ALLOWABLE ROUNDING ERROR ON POINTS AT EXTREAMS OF KNOT RANGE AAOK0438
C IS 2**IEPS*MAX(!XNG(1)!,!XNG(NV)!). AAOK0439
INTEGER*4 IFLG/0/,IEPS/-50/ AAOK0440
DIMENSION XNG(1),FNG(1),GNG(1) AAOK0441
C AAOK0442
C TEST WETHER POINT IN RANGE. AAOK0443
IF(X.LT.XNG(1)) GO TO 990 AAOK0444
IF(X.GT.XNG(NV)) GO TO 991 AAOK0445
C AAOK0446
C ESTIMATE KNOT INTERVAL BY ASSUMING EQUALLY SPACED KNOTS. AAOK0447
12 J=DABS(X-XNG(1))/(XNG(NV)-XNG(1))*(NV-1)+1 AAOK0448
C ENSURE CASE X=XNG(NV) GIVES J=NV-1 AAOK0449
J=MIN0(J,NV-1) AAOK0450
C INDICATE THAT KNOT INTERVAL INSIDE RANGE HAS BEEN USED. AAOK0451
IFLG=1 AAOK0452
C SEARCH FOR KNOT INTERVAL CONTAINING X. AAOK0453
IF(X.LT.XNG(J)) GO TO 2 AAOK0454
C LOOP TILL INTERVAL FOUND. AAOK0455
1 J=J+1 AAOK0456
11 IF(X.GT.XNG(J+1)) GO TO 1 AAOK0457
GO TO 7 AAOK0458
2 J=J-1 AAOK0459
IF(X.LT.XNG(J)) GO TO 2 AAOK0460
C AAOK0461
C CALCULATE SPLINE PARAMETERS FOR JTH INTERVAL. AAOK0462
7 H=XNG(J+1)-XNG(J) AAOK0463
Q1=H*GNG(J) AAOK0464
Q2=H*GNG(J+1) AAOK0465
SS=FNG(J+1)-FNG(J) AAOK0466
B=3D0*SS-2D0*Q1-Q2 AAOK0467
A=Q1+Q2-2D0*SS AAOK0468
C AAOK0469
C CALCULATE SPLINE VALUE. AAOK0470
8 Z=(X-XNG(J))/H AAOK0471
C TF=((A*Z+B)*Z+Q1)*Z+FNG(J) AAOK0472
C TG=((3.*A*Z+2.*B)*Z+Q1)/H AAOK0473
C DGDT=(TG-TF/X)/X AAOK0474
DGDT=(3.*A*Z*Z+2.*B*Z+Q1)/H AAOK0475
RETURN AAOK0476
C TEST IF X WITHIN ROUNDING ERROR OF XNG(1). AAOK0477
990 IF(X.LE.XNG(1)-2D0**IEPS*DMAX1(DABS(XNG(1)),DABS(XNG(NV)))) GO AAOK0478
1 TO 99 AAOK0479
J=1 AAOK0480
GO TO 7 AAOK0481
C TEST IF X WITHIN ROUNDING ERROR OF XNG(NV). AAOK0482
991 IF(X.GE.XNG(NV)+2D0**IEPS*DMAX1(DABS(XNG(1)),DABS(XNG(NV)))) GO AAOK0483
1 TO 99 AAOK0484
J=NV-1 AAOK0485
GO TO 7 AAOK0486
99 IFLG=0 AAOK0487
C FUNCTION VALUE SET TO ZERO FOR POINTS OUTSIDE THE RANGE. AAOK0488
DGDT=0D0 AAOK0489
RETURN AAOK0490
END AAOK0491
This doesn't look so bad. Modern compilers still accept the real*8 syntax although it isn't standard. So you should (as mentioned) replace the line
REAL FUNCTION DGDT*8(IX,NV,XNG,FNG,GNG,X) AAOK0429
with
REAL*8 FUNCTION DGDT(IX,NV,XNG,FNG,GNG,X) AAOK0429
which compiled successfully for me using gfortran 4.6.2 using gfortran -c DGDT.f.
Good luck, and be on the lookout for other problems. Just because the code compiles does not mean it is running the same way it was designed!
Not really an answer, see the one from Ross. But I just can't stand the requirement for fixed form. Here is how this code probably would look like in F90 with free form:
function DGDT(IX, NV, XNG, FNG, GNG, X)
! THIS FUNCTION COMPUTES THE VALUE OF THE DERIVATIVE OF THE
! G-FUNCTION FOR A SLIT TRANSMISSION FUNCTION GIVEN BY A
! PIECE-WISE CUBIC SPLINE, WHOSE PARAMETERS ARE
! CONTAINED IN XNG,FNG AND GNG.
implicit none
integer, parameter :: rk = selected_real_kind(15)
integer :: ix, nv
real(kind=rk) :: dgdt
real(kind=rk) :: xng(nv)
real(kind=rk) :: fng(nv)
real(kind=rk) :: gng(nv)
real(kind=rk) :: x
! ALLOWABLE ROUNDING ERROR ON POINTS AT EXTREAMS OF KNOT RANGE
! IS 2**IEPS*MAX(!XNG(1)!,!XNG(NV)!).
integer, parameter :: ieps = -50
integer, save :: iflg = 0
integer :: j
real(kind=rk) :: tolerance
real(kind=rk) :: H
real(kind=rk) :: A, B
real(kind=rk) :: Q1, Q2
real(kind=rk) :: SS
real(kind=rk) :: Z
tolerance = 2.0_rk**IEPS * MAXVAL(ABS(XNG([1,NV])))
! TEST WETHER POINT IN RANGE.
if ((X < XNG(1) - tolerance) .or. (X > XNG(NV) + tolerance)) then
! FUNCTION VALUE SET TO ZERO FOR POINTS OUTSIDE THE RANGE.
iflg = 0
DGDT = 0.0_rk
return
end if
! ESTIMATE KNOT INTERVAL BY ASSUMING EQUALLY SPACED KNOTS.
J = abs(x-xng(1)) / (xng(nv)-xng(1)) * (nv-1) + 1
! ENSURE CASE X=XNG(NV) GIVES J=NV-1
J = MIN(J,NV-1)
! INDICATE THAT KNOT INTERVAL INSIDE RANGE HAS BEEN USED.
IFLG = 1
! SEARCH FOR KNOT INTERVAL CONTAINING X.
do
if ( (x >= xng(j)) .or. (j==1) ) EXIT
j = j-1
! LOOP TILL INTERVAL FOUND.
end do
do
if ( (x <= xng(j+1)) .or. (j==nv-1) ) EXIT
j = j+1
! LOOP TILL INTERVAL FOUND.
end do
! CALCULATE SPLINE PARAMETERS FOR JTH INTERVAL.
H = XNG(J+1) - XNG(J)
Q1 = H*GNG(J)
Q2 = H*GNG(J+1)
SS = FNG(J+1) - FNG(J)
B = 3.0_rk*SS - 2.0_rk*Q1 - Q2
A = Q1 + Q2 - 2.0_rk*SS
! CALCULATE SPLINE VALUE.
Z = (X-XNG(J))/H
DGDT = ( (3.0_rk*A*Z + 2.0_rk*B)*Z + Q1 ) / H
end function DGDT
Note, I did not test this in any way, also there might be some wrong guesses in there, like that ieps should be a constant. Also, I am not so sure about iflg, and the ix argument does not appear to be used at all. So I might got something wrong. For the tolerance it is better to use a factor instead of a difference and a 2.**-50 will not change the value for a the maxval in a double precision number here. Also note, I am using some other F90 features besides the free form now.
DISCLAIMER: Just mentioning a possible solution here, not recommending it...
As much as all other answers are valid and that supporting some Fortran IV code as is is a nightmare, you still might want / need to avoid touching it as much as possible. And since Fortran IV had some strange behaviours when it comes to loops for example (with loops always cycled at least once IINM), using a "proper" Fortran IV compiler might be a "good" idea.
Anyway, all this to say that the Intel compiler for example, supports Fortran IV natively with the -f66 compiler switch, and I'm sure other compilers do as well. This may be worth checking.

Fortran Error: Unexpected STATEMENT FUNCTION statement at (1)

I'm doing a fortran code to find the radial distribution function (RDF) with hard spheres in a cell model.
It's not finished yet, and now I have an error. I'm implementing the histogram. This is my code.
implicit double precision (a-h,o-z)
parameter(npart=3000)
dimension x(0:npart),y(0:npart),z(0:npart)
c n=Number of particules
c rcel=Radius of the cell
c rpart=Radius of the particules
pi=3.1415927
write(*,*)'n,rcel,rpart,dr?'
read(*,*)n,rcel,rpart,dr
write(*,*)'nstep,dp'
read(*,*)nstep,dp
rpart2=(2*rpart)
nfatmax=rcel/dr ! Number of bins
vtotal=(4/3)*pi*rcel*rcel*rcel
dentotal=n/vtotal
write(*,*)'Density of particles, volume and bins = '
write(*,*)dentotal,vtotal,nfatmax
x(0)=0
y(0)=0
z(0)=0
write(*,'(a,/)')'Generating start configurations'
counter1=0
counter2=0
counter3=0
k=0
do i=1,n
21 xx=rcel*(ran()-0.5)*2
yy=rcel*(ran()-0.5)*2
zz=rcel*(ran()-0.5)*2
rr=xx**2+yy**2+zz**2
dist=sqrt(rr)
if(dist.gt.(rcel-rpart2))then !Avoid particles outside the cell
counter1=counter1+1
go to 21
end if
if(dist.lt.rpart2)then ! Avoid overlap with central particle
counter2=counter2+1
go to 21
end if
if(i.ge.1)then
do j=1,i-1,1
sep2=(x(i)-x(j))**2+(y(i)-y(j))**2+(z(i)-z(j))**2
sep=sqrt(sep2)
if(sep.lt.rpart2)then
counter3=counter3+1
go to 21
end if
end do
end if
k=k+1
x(k)=xx
y(k)=yy
z(k)=zz
end do
write(*,*)'Starting config'
write(*,'(3f8.3)')(x(i),y(i),z(i),i=1,n)
counterA=counter1+counter2+counter3
write(*,*)'Rejection = '
write(*,*)counterA
c Monte Carlo loop
counter4=0
counter5=0
counter6=0
do i = 1,nfatmax
h(i) = 0 !!!! Error here!!!!!!
end do
nobs = 0
naccept = 0
do i=1,nstep
do j=1,n
nobs = nobs + 1
xil=x(j)+dp*(ran()-0.5)
yil=y(j)+dp*(ran()-0.5)
zil=z(j)+dp*(ran()-0.5)
r2=(xil**2)+(yil**2)+(zil**2)
r=sqrt(r2)
if(r.gt.(rcel-rpart2))then
counter4=counter4+1
go to 444 ! Avoid particles outside the cell
end if
if(r.lt.rpart2)then
counter5=counter5+1
go to 444 ! Avoid overlap with central particle
end if
do ii=1,j-1
dist2=(x(ii)-xil)**2+(y(ii)-yil)**2+(z(ii)-zil)**2
dist=sqrt(dist2)
if(dist.lt.rpart2)then
counter6=counter6+1
go to 444 ! Avoid overlap wit particles
end if
end do
c Accepted configuration
x(j)=xil
y(j)=yil
z(j)=zil
naccept = naccept + 1
c Rejected configuration
444 continue
do jj=1,n
dist2=(x(jj))**2+(y(jj))**2+(z(jj))**2
dist=sqrt(dist2)
k=(dist/dr)+1
h(k) = h(k)+1 !!!!!!!! Error here!!!!!!!!!
end do
enddo
end do
write(*,*)'Final config'
write(*,'(3f8.3)')(x(j),y(j),z(j),j=1,n)
counterB=counter4+counter5+counter6
write(*,*)'Rejection ='
write(*,*)counterB
stop
end
In your code, h is not declared...
From
do i = 1,nfatmax
h(i) = 0
end do
I assume it should be an array of length nfatmax:
dimension h(nfatmax)
As stated in High Performance Mark's comment, you could have found this error by using implicit none...
I see you dimensioning x, y and z but I see no such beastie for h.
Perhaps you might want to create the array before trying to put values into it.