解决“呼叫itime(现在)”,“错误#6404:此名称没有类型,并且必须具有显式类型”的解决方案编译错误

发布于 2025-02-06 05:07:46 字数 14616 浏览 2 评论 0原文

我根本不是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 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。
列表为空,暂无数据
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文