解决“呼叫itime(现在)”,“错误#6404:此名称没有类型,并且必须具有显式类型”的解决方案编译错误
我根本不是Fortran程序员,但是我有一个项目,其中原始代码是在Fortran中编写的。我相信这是Fortran 77。问题是我正在尝试编译代码,但是我遇到了各种错误。我很确定该代码应该顺利进行编译,因为原始作者已经对其进行了测试。但是,由于某种原因,当我编译代码时,我会遇到错误。不幸的是,我无法追踪原始作者。
我的猜测是我在编译中做错了什么。因此,如果有人可以设置 我直截了当,那真是太好了。
我有以下代码。我尝试使用一些不同的汇编字符串。注意:还有一个名为inputNewrate.txt
的附加文件,该文件具有该文件的某些设置。我也包括下面的其他文件。
fort77 -c iNCETE.F
f77 -c iNCETE.F
gfortran -c incteet.f
这是代码 - 它很长。然后错误消息低于此。
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
此外,还有一个名为inputNewrate.txt
的文件,该文件具有该模型的设置。我相信这是Input
subroutine在第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
我遇到的错误消息是:
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
对任何帮助表示赞赏。
更新
根据评论者的帮助,一个想法是这可能是Oracle Fortran。我尚无法确认,但是我可以尝试使用Oracle Fortran进行编译。
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.
如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

绑定邮箱获取回复消息
由于您还没有绑定你的真实邮箱,如果其他用户或者作者回复了您的评论,将不能在第一时间通知您!
发布评论