cubbi.com: fibonacci numbers in fortran languages: [english] [русский]
FORTRAN
Date: 1954 (Standardized in ANSI X3.9-1978 and ISO/IEC 1539-1:1997)
Type: Imperative low-level language
Usage: huge libraries of scientific/math code are written in this language and are sometimes still used.
Note: These examples print the largest Fibonacci number calculated correctly in each case.

ALGORITHM 1A: BINARY RECURSION
C Note that g77 -O2 does not compile this program correctly, g77 -O1 works
      PROGRAM F1A
      INTEGER*4 I,K
      I=19
      CALL F(I)
      PRINT *,I,'th Fibonacci number is',K
      STOP
      END PROGRAM
CCCCC
C Subroutine F(I) calculates the I'th Fibonacci number
C It uses closest possible approximation of ALGORITHM 1A: BINARY RECURSION
C that could be done using simple loops and arrays.
C
      SUBROUTINE F(I)
      DIMENSION A(2**I), B(2**I)
      DO1J=1,2**I
      A(J)=0; B(J)=0
1     CONTINUE
      A(1)=I+1;
      IP=0;
4     J2=1
      DO2J=1,2**IP
      B(J2)=A(J)-1
      B(J2+1)=A(J)-2
      J2=J2+2
2     CONTINUE
      DO3J=1,2**I
      A(J)=B(J)
3     CONTINUE
      IP=IP+1
      IF(A(1).GT.1) GO TO 4
9     IP=IP-1
      J2=1
      DO5J=1,2**(IP-1)
      IF(A(J2+1)-0)10,10,12
10    B(J)=A(J2)+1
      GO TO 7
12    B(J)=A(J2)+A(J2+1)
7     J2=J2+2
5     CONTINUE
      DO8J=1,2**(I-1)
      A(J)=B(J)
8     CONTINUE
      IF(IP.GT.1) GO TO 9
      K=A(1)
      RETURN
      END SUBROUTINE

ALGORITHM 2A-3: DATA STRUCTURE - SIMPLE LIST
      PROGRAM F2A
      I=35; K=I
      CALL F(I)
      PRINT *,K,'th Fibonacci number is',I
      STOP
      END PROGRAM
CCCCC
C Subroutine F(I) calculates the I'th Fibonacci number
C It uses ALGORITHM 2A-3: DATA STRUCTURE - SIMPLE LIST
C
      SUBROUTINE F(I)
      DIMENSION A(I+1)
      A(1)=1; A(2)=1
      DO1J=3,I+1
      A(J)=A(J-1)+A(J-2)
1     CONTINUE
      I=A(I+1)
      RETURN
      END SUBROUTINE

ALGORITHM 2B: SIMPLE RECURSION
FORTRAN does not support recursion.
Rewriting this algorithm in simple loops produces ALGORITHM 2C.

ALGORITHM 2C: NON-RECURSIVE LOOP
      PROGRAM F2C
      I=45; K=I
      CALL F(I)
      PRINT *,K,'th Fibonacci number is',I
      STOP
      END PROGRAM
CCCCC
C Subroutine F(I) calculates the I'th Fibonacci number
C It uses ALGORITHM 2C: NON-RECURSIVE LOOP
C
      SUBROUTINE F(I)
      I1=1; I2=1
      DO 2 J=2,I
      I3=I1+I2
      I2=I1
      I1=I3
2     I=I1
      RETURN
      END SUBROUTINE

ALGORITHM 3A: MATRIX EQUATION
      PROGRAM F3A
      I=35; K=I
      CALL F(I)
      PRINT *,K,'th Fibonacci number is',I
      STOP
      END PROGRAM
CCCCC
C Subroutine F(I) calculates the I'th Fibonacci number
C It uses ALGORITHM 3A: MATRIX EQUATION, rewritten
C to use non-recursive loops.
C
      SUBROUTINE F(I)
      DIMENSION A(2,2),B(2,2),C(2,2)
      INTEGER L
      A(1,1)=2; A(1,2)=1; A(2,1)=1; A(2,2)=1
      B(1,1)=1; B(1,2)=0; B(2,1)=0; B(2,2)=1
      J=I/2; J1=1
      IF(AND(J,J1).NE.0) CALL MCOPY(A,B)
4     IF(J1.GE.J) GO TO 3
      CALL MMULT (A,A,C)
      CALL MCOPY (C,A)
      J=J/2
      IF(AND(J,J1).EQ.0) GO TO 4
      CALL MMULT(A,B,C)
      CALL MCOPY(C,B)
      GO TO 4
3     IF(MOD(I,2).NE.0) GO TO 2
      I=B(1,1)
      RETURN
2     I=B(1,1)+B(1,2)
      RETURN
      END SUBROUTINE
C Subroutine MMULT mutiplies two 2x2 matrices D and E and writes the result to C
      SUBROUTINE MMULT(D,E,C)
      DIMENSION D(2,2),E(2,2),C(2,2)
      C(1,1)=D(1,1)*E(1,1)+D(1,2)*E(2,1);
      C(1,2)=D(1,1)*E(1,2)+D(1,2)*E(2,2);
      C(2,1)=D(2,1)*E(1,1)+D(2,2)*E(2,1);
      C(2,2)=D(2,1)*E(1,2)+D(2,2)*E(2,2);
      RETURN
      END SUBROUTINE
C  Subroutine MCOPY(D,E) copies the 2x2 matrix D into 2x2 matrix E
      SUBROUTINE MCOPY(D,E)
      DIMENSION D(2,2),E(2,2)
      E(1,1)=D(1,1); E(1,2)=D(1,2)
      E(2,1)=D(2,1); E(2,2)=D(2,2)
      RETURN
      END SUBROUTINE

ALGORITHM 3B: FAST RECURSION
      PROGRAM F3B
      I=45; K=I
      CALL F(I)
      PRINT *,K,'th Fibonacci number is',I
      STOP
      END PROGRAM
CCCCC
C Subroutine F(I) calculates the I'th Fibonacci number
C It uses ALGORITHM 3B: FAST RECURSION, rewritten
C to use non-recursive loops, because FORTRAN does not
C support recursion.
C
      SUBROUTINE F(I)
      J1=LOG(I+1.)/LOG(2.)
      JL=2**J1-2
      JR=2**(J1+1)-2
      JM=(JL+JR)/2
      IF(I-JM)2,2,1
1     JL=JM
      I1=2; I2=1; N=2
      GO TO 3
2     JR=JM
      I1=1; I2=1; N=1
3     IF(N-I)11,7,7
11    JM=(JL+JR)/2
      IF(I-JM)5,5,4
4     JL=JM
      N=(N+1)*2
      ITMP=(I1+I2)**2+I1**2
      I2=(I1+I2)*I1+I1*I2
      I1=ITMP
      GO TO 6
5     JR=JM
      N=2*N+1
      ITMP=I1*(I1+I2)+I1*I2
      I2=I1**2+I2**2
      I1=ITMP
6     IF(N-I)11,7,7
7     I=I1
      RETURN
      END SUBROUTINE

ALGORITHM 3C: BINET'S FORMULA
      PROGRAM F3C
      I=31; K=I
      CALL F(I)
      PRINT *,K,'th Fibonacci number is',I
      STOP
      END PROGRAM
CCCCC
C Subroutine F(I) calculates the I'th Fibonacci number
C It uses ALGORITHM 3C: BINET'S FORMULA
C
      SUBROUTINE F(I)
      REAL*8 PHI
      IF(I.LT.2) GO TO 1
      PHI=(1+SQRT(5.))/2.
      I=(PHI**(I+1) - (1.-PHI)**(I+1)) / SQRT(5.)
      RETURN
1     I=1
      RETURN
      END SUBROUTINE