I am not a Fortran programmer at all, but I have a project where the original code was written in Fortran. I believe it is Fortran 77. The issue is that I am trying to compile the code, but I am getting all sorts of errors. I am pretty sure that this code should compile smoothly, since it has been tested a bunch by the original author. However, for some reason when I compile the code, I get errors. Unfortunately, I can't track down the original author.
My guess is that I am doing something wrong with the compilation. So if someone can set me straight on that, that would be wonderful.
I have the code below. I tried using a few different compilation strings. NOTE: There is an additional file called inputnewrate.txt that has some settings for this file. I have include that additional file below as well.
fort77 -c discrete.f
f77 -c discrete.f
gfortran -c discrete.f
Here is the code--it is pretty long. And then the error message is below that.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
program implicit
implicit none
integer i,j,n,l,pic,screen,guy,burgsatloc(512,512),k,
$ robbyloc(512,512),outcome,newburgs(512,512),willplace,
$ totalguys,in,jn,totalburgs(512,512),neighbors(512,512,4,2)
integer*4 today(3),now(3)
double precision A(512,512),t/0.0d0/,dt,tint,gamma,Bbar,
$ tmax,omega,theta,eta,A0,disp/0.0d0/,placeprob,
$ robprob,Bavg,B(512,512),rbar,moveprob(5),newB(512,512)
real ran2,rtmp
call idate(today)
call itime(now)
rtmp=ran2(-(today(1)+today(2)+today(3)+now(1)+now(2)+now(3)))
call input(l,tmax,tint,dt,omega,theta,eta,A0,
$ gamma)
placeprob=gamma*dt
Bbar=theta*gamma/omega
rbar=placeprob/(1.0d0-exp(-(A0+Bbar)*dt))
call initialize(burgsatloc,B,l,pic,screen,rbar,Bbar)
willplace=int(placeprob)
placeprob=placeprob-dble(willplace)
call getneighbors(l,neighbors)
do i=1,l
do j=1,l
robbyloc(i,j)=0
totalburgs(i,j)=0
enddo
enddo
do while (t .LT. tmax)
totalguys=0
do i=1,l
do j=1,l
totalguys=totalguys+burgsatloc(i,j)
newburgs(i,j)=0
robbyloc(i,j)=0
A(i,j)=B(i,j)+A0
enddo
enddo
if (t .GE. tint*disp) then
call output(A,burgsatloc,t,l,pic,screen,A0,Bbar)
write(*,*) 'totalguys=',totalguys
disp=disp+1.0d0
endif
c See if burglars burgle. If so, remove them.
do i=1,l
do j=1,l
n=burgsatloc(i,j)
if (n .NE. 0) then
robprob=1.0d0-exp(-A(i,j)*dt)
endif
do guy=1,n
call probcheck(robprob,1,outcome)
if (outcome .EQ. 1) then
robbyloc(i,j)=robbyloc(i,j)+1
totalburgs(i,j)=totalburgs(i,j)+1
burgsatloc(i,j)=burgsatloc(i,j)-1
endif
enddo
enddo
enddo
c Now, move the burglars that didn't burgle.
do i=1,l
do j=1,l
n=burgsatloc(i,j)
if (n .NE. 0) then
call getmoveprob(i,j,A,neighbors,moveprob)
endif
do guy=1,n
call probcheck(moveprob,4,outcome)
c if (outcome .NE. 5) then
in=neighbors(i,j,outcome,1)
jn=neighbors(i,j,outcome,2)
c else
c in=i
c jn=j
c endif
newburgs(in,jn)=newburgs(in,jn)+1
enddo
enddo
enddo
do i=1,l
do j=1,l
burgsatloc(i,j)=newburgs(i,j)+willplace
enddo
enddo
c Now, loop over each location and update the A there and place
c new burglars
do i=1,l
do j=1,l
call findavg(i,j,neighbors,B,Bavg)
newB(i,j)=((1.0d0-eta)*B(i,j)+eta*Bavg)*
$ (1.0d0-omega*dt)+theta*dble(robbyloc(i,j))
call probcheck(placeprob,1,outcome)
if (outcome .EQ. 1) then
burgsatloc(i,j)=burgsatloc(i,j)+1
endif
enddo
enddo
do i=1,l
do j=1,l
B(i,j)=newB(i,j)
enddo
enddo
t=t+dt
c write(*,*) 'time=',t
enddo
call PGCLOS
end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
subroutine input(l,tmax,tint,dt,omega,theta,eta,A0,
$ gamma)
implicit none
integer l,file
double precision tmax,tint,dt,omega,theta,eta,A0,gamma
c Allows for interactive selection of properties
file=20
open(unit=file,file="inputnewrate.txt")
read(file,*) l
read(file,*) tmax
read(file,*) tint
read(file,*) dt
read(file,*) omega
read(file,*) A0
read(file,*) theta
read(file,*) eta
call itime(now)
read(file,*) gamma
close(file)
c nbar=1.0d0
c A0=r0/(1.0d0-r0)
c beta=lambda/rbar*(rbar/(1.0d0-rbar)-A0)
c delta=beta/nbar
c dt=(1.0d0/dble(l-1))**2/D
c placeprob=rbar*nbar*dt
return
end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
subroutine initialize(burgsatloc,B,l,pic,screen,rbar,Bbar)
implicit none
integer l,pic,screen,i,j,k,PGOPEN,burgsatloc(512,*),nbar,outc
real rand,red,green,blue
double precision B(512,*),rbar,Bbar,frac
nbar=int(rbar)
frac=rbar-dble(nbar)
write(*,*) nbar,frac,Bbar
do i=1,l
do j=1,l
burgsatloc(i,j)=nbar
call probcheck(frac,1,outc)
if (outc .EQ. 1) then
burgsatloc(i,j)=burgsatloc(i,j)+1
endif
B(i,j)=Bbar
enddo
enddo
c burgsatloc((l+1)/2,(l+1)/2)=10000
c Now open the PGPLOT display
c pic=PGOPEN('crime#.gif/gif')
pic=PGOPEN('/xserv')
if (pic .LE. 0) stop
c if (screen .LE. 0) stop
call PGPAP(5.0,1.0)
call PGASK(.FALSE.)
call PGSCIR(16,94)
do i=16,42
red=1.0
green=1.0/26.0*real(i-16)
blue=0.0
call PGSCR(i,red,green,blue)
enddo
do i=43,55
red=max(1.0-1.0/13.0*real(i-42),0.0)
green=1.0
blue=0.0
call PGSCR(i,red,green,blue)
enddo
do i=56,68
red=0.0
call itime(now)
green=1.0
blue=1.0/13.0*real(i-55)
call PGSCR(i,red,green,blue)
enddo
do i=69,81
red=0.0
green=max(1.0-1.0/13.0*real(i-68),0.0)
blue=1.0
call PGSCR(i,red,green,blue)
enddo
do i=82,94
red=1.0/13.0*real(i-81)
green=0.0
blue=1.0
call PGSCR(i,red,green,blue)
enddo
return
end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
subroutine output(A,burgsatloc,t,l,pic,screen,A0,Bbar)
implicit none
integer l,pic,screen,i,j,lengtht,burgsatloc(512,*)
character*7 tchar
double precision t,A(512,*),A0,Bbar
real dx,trans(6),minmum,maxmum,crime(512,512)
dx=1.0/real(l)
trans(1)=-dx/2.0
trans(2)=dx
trans(3)=0.0
trans(4)=trans(1)
trans(5)=trans(3)
trans(6)=trans(2)
c maxmum=2.0*real(rbar)
c minmum=0.0
minmum=real(A0)
maxmum=real(2.0d0*Bbar+A0)
do i=1,l
do j=1,l
c crime(i,j)=real(min(burgsatloc(i,j),1))
crime(i,j)=real(A(i,j))
enddo
enddo
c call minmax(crime,l,minmum,maxmum)
c if (minmum .EQ. maxmum) then
c if (minmum .EQ. 0.0) then
c maxmum=1.0
c minmum=-1.0
c else
c maxmum=1.01*maxmum
c minmum=minmum/1.01
c endif
c endif
c write(*,*) minmum,maxmum
call PGBBUF()
call PGNUMB(int(t*1.0d2),-2,1,tchar,lengtht)
c call PGSLCT(pic)
call PGENV(0.0,1.0,0.0,1.0,1,0)
call PGLAB('x','y','A(x,y,t), Time='
$ //tchar(1:lengtht))
call PGIMAG(crime,512,512,1,l,1,l,maxmum,minmum,trans)
c call PGSLCT(screen)
c call PGENV(0.0,1.0,0.0,1.0,1,0)
c call PGLAB('x','y','crime rate(x,y,t), Time='
c $ //tchar(1:lengtht))
c call PGIMAG(crime,1024,1024,1,n,1,n,maxmum,minmum,trans)
call PGEBUF()
return
end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
subroutine probcheck(problist,length,outcome)
implicit none
integer length,outcome,i
double precision problist(*),currentprob
real ran2,rtmp
logical looking
rtmp=ran2(13)
if (length .EQ. 1) then
if (dble(rtmp) .LE. problist(1)) then
outcome=1
else
outcome=0
endif
else
looking=.TRUE.
i=1
do while (looking .AND. i .LE. length-1)
if (i .EQ. 1) then
currentprob=problist(1)
else
currentprob=currentprob+problist(i)
endif
if (rtmp .LE. currentprob) then
outcome=i
looking=.FALSE.
else
i=i+1
endif
enddo
if (looking) outcome=length
endif
return
end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
subroutine getmoveprob(i,j,A,neighbors,moveprob)
implicit none
integer i,j,neighbors(512,512,4,*),k,in,jn
double precision A(512,*),moveprob(*),sum
sum=0.0d0
do k=1,4
in=neighbors(i,j,k,1)
jn=neighbors(i,j,k,2)
moveprob(k)=A(in,jn)
sum=sum+moveprob(k)
enddo
c moveprob(5)=A(i,j)
c sum=sum+moveprob(5)
if (sum .NE. 0.0d0) then
c do k=1,5
do k=1,4
moveprob(k)=moveprob(k)/sum
enddo
else
c do k=1,5
do k=1,4
moveprob(k)=0.25d0
enddo
endif
return
end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
subroutine getneighbors(l,neighbors)
implicit none
integer i,j,l,neighbors(512,512,4,*)
do i=1,l
do j=1,l
neighbors(i,j,1,1)=i
if (j .NE. l) then
neighbors(i,j,1,2)=j+1
else
neighbors(i,j,1,2)=1
endif
if (i .NE. l) then
neighbors(i,j,2,1)=i+1
else
neighbors(i,j,2,1)=1
endif
neighbors(i,j,2,2)=j
neighbors(i,j,3,1)=i
if (j .NE. 1) then
neighbors(i,j,3,2)=j-1
else
neighbors(i,j,3,2)=l
endif
if (i .NE. 1) then
neighbors(i,j,4,1)=i-1
else
neighbors(i,j,4,1)=l
endif
neighbors(i,j,4,2)=j
enddo
enddo
return
end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
subroutine findavg(i,j,neighbors,B,Bavg)
implicit none
integer i,j,neighbors(512,512,4,*),k,in,jn
double precision B(512,*),Bavg
Bavg=0.0d0
do k=1,4
in=neighbors(i,j,k,1)
jn=neighbors(i,j,k,2)
Bavg=Bavg+B(in,jn)
enddo
Bavg=Bavg/4.0d0
return
end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
subroutine minmax(z,l,min,max)
implicit none
integer l,i,j
real z(512,*),min,max
min=z(1,1)
max=z(1,1)
do i=1,l
do j=1,l
if (z(i,j) .GT. max) max=z(i,j)
if (z(i,j) .LT. min) min=z(i,j)
enddo
enddo
return
end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
function ran2(idummy)
implicit none
integer idum,im1,im2,imm1,ia1,ia2,iq1,iq2,ir1,ir2,ntab,ndiv,idummy
real ran2,am,eps,rnmx
parameter (im1=2147483563,im2=2147483399,am=1./im1,imm1=im1-1,
$ ia1=40014,ia2=40692,iq1=53668,iq2=52774,ir1=12211,
$ ir2=3791,ntab=32,ndiv=1+imm1/ntab,eps=1.2e-7,rnmx=1.-eps)
integer idum2,j,k,iv(ntab),iy
save iv,iy,idum2
data idum2/123456789/, iv/ntab*0/, iy/0/
idum=idummy
if (idum .le. 0) then
idum=max(-idum,1)
idum2=idum
do j=ntab+8,1,-1
k=idum/iq1
idum=ia1*(idum-k*iq1)-k*ir1
if (idum .lt. 0) idum=idum+im1
if (j .le. ntab) iv(j)=idum
enddo
iy=iv(1)
endif
k=idum/iq1
idum=ia1*(idum-k*iq1)-k*ir1
if (idum .lt. 0) idum=idum+im1
k=idum2/iq2
idum2=ia2*(idum2-k*iq2)-k*ir2
if (idum2 .lt. 0) idum2=idum2+im2
j=1+iy/ndiv
iy=iv(j)-idum2
iv(j)=idum
if (iy .lt. 1) iy=iy+imm1
ran2=min(am*iy,rnmx)
return
end
Further, there is a file called inputnewrate.txt which has settings for the model. I believe this is the file referenced in the input subroutine around line 114.
128 length of side 420
364.0 Simulation time 2174
1.0 Time between outputs
0.01 dt 0.01
0.06667 omega 0.06667
0.13425 a0 (0.13425 for subcritical, 0.03333 for standard)
0.2194 theta 0.05561 is for nbar=1, gets bigger for smaller nbar (0.2194 for subcritical) 48.0491178 5.574
0.006 eta (0.006 for subcritical) 0.02
0.01998 gamma 0.1998 is for nbar=1, gets smaller for smaller nbar 0.000023124 0.00131 (0.02 for subcritical)
0.0 f, the fraction of simulated events to be replaced with the real events
0.03333 a0 (0.13425 for subcritical, 0.03333 for standard)
3.97406 theta 0.05561 is for nbar=1, gets bigger for smaller nbar (0.02194 for subcritical) 48.0491178 5.574
0.01 eta (0.006 for subcritical) 0.02
0.0018374 gamma 0.1998 is for nbar=1, gets smaller for smaller nbar 0.000023124 0.00131
0.90 f, the fraction of simulated events to be replaced with the real events
0.0714 omega 0.0714
0.0 r0 0.00033
0.00000714 rbar 0.0025
0.8 eta 0.02
1.0 nbar 0.1
The error messages I am hitting are:
fort77 -c discrete.f
MAIN implicit:
Error on line 8: attempt to give DATA in type-declaration
Warning on line 111: local variable k never used
input:
Error on line 130: Declaration error for now: attempt to use undefined variable
initialize:
Error on line 186: Declaration error for now: attempt to use undefined variable
Warning on line 205: local variable k never used
Warning on line 205: local variable rand never used
output:
probcheck:
getmoveprob:
getneighbors:
findavg:
minmax:
ran2:
/usr/bin/fort77: aborting compilation
Any help is appreciated.
UPDATE
Based upon the help of the commenters, one thought is that this might be Oracle Fortran. I can't confirm that yet, but I can try to compile using Oracle Fortran.