Компиляция кода Fortran IV с компилятором Fortran 77

Question

У меня есть код в 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 

Answer 1

Это не выглядит так плохо. Современные компиляторы все еще принимают синтаксис 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 с помощью gfortran -c DGDT.f.

Удачи, и будьте в поиске других проблем. Просто потому, что код компилирует не означает, что он работает так же, как он был разработан!

Answer 2

Не совсем ответ, см. Один от Росса. Но я просто не могу выдержать требования к фиксированной форме. Вот как этот код, вероятно, будет выглядеть в 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, помимо бесплатной формы.

Answer 3

ОТКАЗ: Просто упоминая возможное решение здесь, а не рекомендовать его ...

Столько, сколько все остальные ответы справедливы и что поддержка некоторого Fortran IV кода, как это кошмар, вы все еще можете/нужно избегать прикосновения к нему как можно больше. И поскольку у Fortran IV было какое-то странное поведение, когда речь идет о циклах (например, петли всегда циклически, по крайней мере, один раз IINM), использование «правильного» компилятора Fortran IV может быть «хорошей» идеей.

В любом случае, все это означает, что компилятор Intel, например, поддерживает Fortran IV изначально с помощью компилятора -f66, и я уверен, что другие компиляторы также работают. Это может стоить проверить.