Subroutines in Fortran (chapter 3)

C Subroutines in Fortran

C Fortran-II subroutine - Section 3.2

      SUBROUTINE QUADRATIC(A, B, C, X1, X2)
      D = SQRT(B*B - 4*A*C)
      X1 = (-B + D) / (2*A)
      X2 = (-B - D) / (2*A)
      RETURN
      END

C Fortran-II function - Section 3.2

      FUNCTION AVRG(ARR, N)
      DIMENSION ARR(N)
      SUM = ARR(1)
      DO 10 I = 2, N
         SUM = SUM + ARR(I)
 10   CONTINUE
      AVRG = SUM / FLOAT(N)
      RETURN
      END

C Fortran-77 subroutine with multiple return points - Section 3.4

      SUBROUTINE QUADRATICSAFE(A, B, C, X1, X2, *)
      D = B*B - 4*A*C
      IF (D .LT. 0) RETURN 1
      D = SQRT(D)
      X1 = (-B + D) / (2*A)
      X2 = (-B - D) / (2*A)
      RETURN
      END

C The main program

      INTEGER RETADDR
      REAL T(10)

C Fortran-II simple function (section 3.2)

      REAL INTPOL
      INTPOL(X) = A * X + B * (1.0 - X)

C Fortran-I subroutine call
      PRINT *, 'Solving quadratic equation'
      A = 3
      B = -8
      C = 1
      ASSIGN 100 to RETADDR
      GOTO 1000
 100  PRINT *, 'FORTRAN-I style:  X1 = ', X1, ' X2 = ', X2

C Fortran-II subroutine call
      CALL QUADRATIC(3., -8., 1., X1, X2)
      PRINT *, 'FORTRAN-II style: X1 = ', X1, ' X2 = ', X2

C Fortran-77 subroutine call with label as argument
      CALL QUADRATICSAFE(3., -8., 1., X1, X2, *101)
      PRINT *, 'FORTRAN-77 style: X1 = ', X1, ' X2 = ', X2
      CALL QUADRATICSAFE(1., 0., 1., X1, X2, *101)
      PRINT *, 'Should not get here'
      STOP
 101  PRINT *, 'FORTRAN-77 style: no solutions'

C Using a simple function
      A = 1.2
      B = 5.4
      PRINT *, 'Linear interpolation: ', INTPOL(0.5)

C Using a function defined by a FUNCTION declaration
      DO 110 I = 1, 10
         T(I) = FLOAT(I) * FLOAT(I)
 110  CONTINUE
      PRINT *, 'Array average: ', AVRG(T, 10)

      STOP

C Implementing a subroutine in Fortran-I - Section 3.1

 1000 D = SQRT(B*B - 4*A*C)
      X1 = (-B + D) / (2*A)
      X2 = (-B - D) / (2*A)
      GOTO RETADDR

      END