使用Fortran 77编译器编译Fortran IV代码

时间:2015-09-17 17:11:43

标签: fortran

我需要运行Fortran IV中的代码。有人告诉我尝试在Fortran 77中编译它并修复错误。所以我用.f扩展名命名该文件并尝试用gfortran编译它。我得到了下一个错误,指的是下面复制的Fortran IV函数:

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)

由于我对Fortran不太熟悉,如果有人能告诉我如何解决这个问题,我会很感激。

      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

3 个答案:

答案 0 :(得分:2)

这看起来并不那么糟糕。现代编译器仍然接受/^http:\/\//m 语法,尽管它不是标准的。所以你应该(如上所述)替换

real*8

  REAL FUNCTION DGDT*8(IX,NV,XNG,FNG,GNG,X)                         AAOK0429

使用 REAL*8 FUNCTION DGDT(IX,NV,XNG,FNG,GNG,X) AAOK0429 使用gfortran 4.6.2为我成功编译。

祝你好运,并留意其他问题。仅仅因为代码编译而不是意味着它的运行方式与它的设计方式相同!

答案 1 :(得分:0)

不是真正的答案,请看Ross的那个。但我不能满足固定形式的要求。以下是F90中自由形式的代码:

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

注意,我没有以任何方式对此进行测试,也可能存在一些错误的猜测,例如ieps应该是常量。另外,我对iflg不太确定,ix参数似乎根本没有使用。所以我可能会出错。对于公差,最好使用因子而不是差值,2.**-50不会在此处更改双精度数中maxval的值。另请注意,我现在使用除自由表格之外的其他一些F90功能。

答案 2 :(得分:0)

免责声明:这里只提一个可能的解决方案,不推荐它......

尽管所有其他答案都是有效的并且支持某些Fortran IV代码是一场噩梦,但您仍然可能希望/需要尽可能避免触及它。而且,由于Fortran IV在循环方面有一些奇怪的行为(循环总是至少循环一次IINM),使用“正确的”Fortran IV编译器可能是一个“好”的想法。 / p>

无论如何,所有这些都说英特尔编译器,例如,支持Fortran IV本地使用-f66编译器开关,我相信其他编译器也可以。这可能值得一试。