Fortran运行时错误:实数错误

时间:2014-04-04 05:50:27

标签: fortran gfortran

我的代码如下所示。它应该读取二进制文件并生成特殊格式。 (此代码是午睡代码的一部分。)但是,执行代码时收到以下错误:

At line 127 of file grid2cube.f (unit = 5, file = 'stdin')
Fortran runtime error: Bad real number in item 0 of list input

我编译主代码的fortran编译器和标志是:

  

FC = / usr / local / bin / mpif90   FFLAGS = -g -O2 FPPFLAGS = -DMPI   -DFC_HAVE_FLUSH -DFC_HAVE_ABORT LDFLAGS =

此代码也使用相同的标志进行编译:

  

/ usr / local / bin / mpif90 -c -g -O2 grid2cube.f   / usr / local / bin / mpif90 -o grid2cube grid2cube.o

我也改变了#34; -O2"到" -O1"和" O0"并重新编译了一切。但是产生了同样的错误。除此之外,我使用mpich-3.0.4和gfortran作为基础。

请帮我纠正这个错误。

program grid2cube
      implicit none

      integer           maxp, natmax, nskip

      parameter         (maxp = 12000000)
      parameter         (natmax = 1000)

      integer           ipt, isp, ix, iy, iz, i, ip, natoms, np, 
     .                  mesh(3), nspin, Ind, id(3), iix, iiy,
     .                  iiz, ii, length, lb
      integer           is(natmax), izat(natmax)

      character         sysname*70, fnamein*75, fnameout(2)*75, 
     .                  fnamexv*75, paste*74, task*5, fform*12

      double precision              rho(maxp,2), rhot(maxp,2)

      double precision  cell(3,3), xat(natmax,3), cm(3), rt(3),
     .                  delta(3), dr(3), residual

      external  paste, lb

c ---------------------------------------------------------------------------

      read(*,*)
      read(5,*) sysname
      read(5,*) task
      read(5,*) rt(1),rt(2),rt(3)
      read(5,*) nskip
      read(5,*) fform

      fnamexv = paste(sysname,'.XV')
      if (task .eq. 'rho') then
        fnamein = paste(sysname,'.RHO')
      else if (task .eq. 'drho') then 
        fnamein = paste(sysname,'.DRHO')
      else if (task .eq. 'ldos') then 
        fnamein = paste(sysname,'.LDOS')
      else if (task .eq. 'vt') then 
        fnamein = paste(sysname,'.VT')
      else if (task .eq. 'vh') then 
        fnamein = paste(sysname,'.VH')
      else if (task .eq. 'bader') then 
        fnamein = paste(sysname,'.BADER')
      else
        write(6,*) 'Wrong task'
        write(6,*) 'Accepted values:  rho, drho, ldos, vh, vt, bader'
        write(6,*) '(in lower case!!!!)'
        stop
      endif


      length = lb(fnamein)
      write(6,*) 
      write(6,*) 'Reading grid data from file ',fnamein(1:length)

c read function from the 3D grid --------------------------------------------

      open( unit=1, file=fnamein, form=fform, status='old' )

      if (fform .eq. 'unformatted') then
        read(1) cell
      else if (fform .eq. 'formatted') then
        do ix=1,3
          read(1,*) (cell(iy,ix),iy=1,3)
        enddo
      else
        stop 'ERROR: last input line must be formatted or unformatted'
      endif


      write(6,*) 
      write(6,*) 'Cell vectors'
      write(6,*) 
      write(6,*) cell(1,1),cell(2,1),cell(3,1)
      write(6,*) cell(1,2),cell(2,2),cell(3,2)
      write(6,*) cell(1,3),cell(2,3),cell(3,3)

      residual = 0.0d0
      do ix=1,3
      do iy=ix+1,3
        residual = residual + cell(ix,iy)**2
      enddo
      enddo

      if (residual .gt. 1.0d-6) then
        write(6,*) 
        write(6,*) 'ERROR: this progam can only handle orthogonal cells'
        write(6,*) ' with vectors pointing in the X, Y and Z directions'
        stop
      endif

      if (fform .eq. 'unformatted') then
        read(1) mesh, nspin
      else
        read(1,*) mesh, nspin
      endif

      write(6,*) 
      write(6,*) 'Grid mesh: ',mesh(1),'x',mesh(2),'x',mesh(3)
      write(6,*) 
      write(6,*) 'nspin = ',nspin
      write(6,*) 

      do ix=1,3
        dr(ix)=cell(ix,ix)/mesh(ix)
      enddo

      np = mesh(1) * mesh(2) * mesh(3)
      if (np .gt. maxp) stop 'grid2d: Parameter MAXP too small'
C      read(1) ( (rho(ip,isp), ip = 1, np), isp = 1,nspin)
      do isp=1,nspin
        Ind=0
        if (fform .eq. 'unformatted') then
          do iz=1,mesh(3)
          do iy=1,mesh(2)
            read(1) (rho(Ind+ix,isp),ix=1,mesh(1))
            Ind=Ind+mesh(1)
          enddo
          enddo
        else
          do iz=1,mesh(3)
          do iy=1,mesh(2)
            read(1,'(e15.6)') (rho(Ind+ix,isp),ix=1,mesh(1))
            Ind=Ind+mesh(1)
          enddo
          enddo
        endif
      enddo

C translate cell
      do ix=1,3
        delta(ix) = rt(ix)/dr(ix)
        id(ix) = delta(ix)
        delta(ix) = rt(ix) - id(ix) * dr(ix)
      enddo

      do iz=1,mesh(3)
      do iy=1,mesh(2)
      do ix=1,mesh(1)
        iix=ix+id(1)
        iiy=iy+id(2)
        iiz=iz+id(3)
        if (iix .lt. 1) iix=iix+mesh(1)
        if (iiy .lt. 1) iiy=iiy+mesh(2)
        if (iiz .lt. 1) iiz=iiz+mesh(3)
        if (iix .gt. mesh(1)) iix=iix-mesh(1)
        if (iiy .gt. mesh(2)) iiy=iiy-mesh(2)
        if (iiz .gt. mesh(3)) iiz=iiz-mesh(3)

        if (iix .lt. 1) stop 'ix < 0'
        if (iiy .lt. 1) stop 'iy < 0'
        if (iiz .lt. 1) stop 'iz < 0'
        if (iix .gt. mesh(1)) stop 'ix > cell'
        if (iiy .gt. mesh(2)) stop 'iy > cell'
        if (iiz .gt. mesh(3)) stop 'iz > cell'
        i=ix+(iy-1)*mesh(1)+(iz-1)*mesh(1)*mesh(2)
        ii=iix+(iiy-1)*mesh(1)+(iiz-1)*mesh(1)*mesh(2)
        do isp=1,nspin
          rhot(ii,isp)=rho(i,isp)
        enddo
      enddo
      enddo
      enddo

      close(1)

      open( unit=3, file=fnamexv, status='old', form='formatted')
      read(3,*)
      read(3,*)
      read(3,*)
      read(3,*) natoms
      do i=1,natoms
        read(3,*) is(i),izat(i),(xat(i,ix),ix=1,3)
      enddo

      do i=1,natoms
        do ix=1,3
          xat(i,ix)=xat(i,ix)+rt(ix)-delta(ix)
          if (xat(i,ix) .lt. 0.0) xat(i,ix)=xat(i,ix)+cell(ix,ix)
          if (xat(i,ix) .gt. cell(ix,ix)) 
     .        xat(i,ix)=xat(i,ix)-cell(ix,ix)
        enddo
      enddo
      close(3)



      if (nspin .eq. 1) then
        fnameout(1) = paste(fnamein,'.cube')
      else if (nspin .eq. 2) then
        fnameout(1) = paste(fnamein,'.UP.cube')
        fnameout(2) = paste(fnamein,'.DN.cube')
      else 
        stop 'nspin must be either 1 or 2'
      endif

      do isp=1,nspin

      length = lb(fnameout(isp))
      write(6,*) 'Writing CUBE file ',fnameout(isp)(1:length)

C      open( unit=2, file=fnameout(isp), status='new', form='formatted')
      open( unit=2, file=fnameout(isp), form='formatted')

      length = lb(fnameout(isp))
      write(2,*) fnameout(isp)(1:length)
      write(2,*) fnameout(isp)(1:length)
      write(2,'(i5,4f12.6)') natoms, 0.0,0.0,0.0

      do ix=1,3
        ii = mesh(ix)/nskip
        if (ii*nskip .ne. mesh(ix)) ii = ii+1
        write(2,'(i5,4f12.6)') 
     .    ii,(cell(ix,iy)/ii,iy=1,3)
      enddo

      do i=1,natoms
        write(2,'(i5,4f12.6)') izat(i),0.0,(xat(i,ix),ix=1,3)
      enddo



      do ix=1,mesh(1),nskip
      do iy=1,mesh(2),nskip

        write(2,'(6e13.5)') 
     .  (rhot(ix+(iy-1)*mesh(1)+(iz-1)*mesh(1)*mesh(2),isp), 
     .   iz=1,mesh(3),nskip)

      enddo
      enddo

      close(2)

      enddo

      write(6,*) 

      end


      CHARACTER*(*) FUNCTION PASTE( STR1, STR2 )

C CONCATENATES THE STRINGS STR1 AND STR2 REMOVING BLANKS IN BETWEEN
C Writen by Jose M. Soler

      CHARACTER*(*) STR1, STR2
      DO 10 L = LEN( STR1 ), 1, -1
         IF (STR1(L:L) .NE. ' ') GOTO 20
   10 CONTINUE
   20 PASTE = STR1(1:L)//STR2
      END


      INTEGER FUNCTION LB ( STR1 )

C RETURNS THE SIZE IF STRING STR1 WITH BLANKS REMOVED
C Writen by P. Ordejon from Soler's paste.f

      CHARACTER*(*) STR1
      DO 10 L = LEN( STR1 ), 1, -1
         IF (STR1(L:L) .NE. ' ') GOTO 20
   10 CONTINUE
   20 LB = L
      END

1 个答案:

答案 0 :(得分:3)

错误行中的陈述是:

read(5,*) rt(1),rt(2),rt(3)

这是一个列表导向的格式化读取。正如您在评论中指出的那样,您正在尝试读取二进制(未格式化)数据。那不行。上面的陈述需要格式化的数据,这意味着带有人类可读数字的文本。

预连接单元5也是标准输入。如果您第一次从中读取格式(read(5,*) sysname),它对于无格式数据不起作用。

旁注:标准输入的数字5不是标准化的,但在实践中是非常安全的假设。但无论如何我会使用*而不是5。

对评论的回应: (*,*)也无法正常工作。通常,每当您提供一种格式(即括号中的第二个参数进行读取或写入)时,您都会格式化i / o。如果格式是*或不同的东西并不重要。您无法以这种方式读取未格式化的数据。您必须使用form=unformatted打开任何可能access的无格式读取文件,并阅读:

read(file_unit_number) rt(1),rt(2),rt(3)

如果您无法将数据文件中的数字作为文本读取,则无法使用格式化读取。