Fortran Examples


Example 1: How to write recursive routines in FORTRAN 77
Example 2: Behavior of local variables in recursive routines in FORTRAN 77
Example 3: Use of the DATA statement in recursive routines in FORTRAN 77
Example 4: Summary of local variable behavior on several platforms.
Example 5: DO Loops in Fortran.

More examples in the future.

Example 1: Recursive Routines in FORTRAN 77 (and Fortran 90)

First let me say that I think every serious Fortran programmer should always write new code in Fortran 90 or Fortran 95, but for those of you stuck on a desert island with only a FORTRAN 77 compiler at your disposal, here's a way to write a recursive subroutine. FORTRAN 77 subroutines and functions are not allowed to call themselves directly. Attempting to do such will result in a compile time error with compilers that adhere to the FORTRAN 77 standard. However, one can implement recursion in a round about way by passing the subroutine as an argument to itself. The subroutine can then call itself by calling the dummy subroutine.
      PROGRAM MAIN
      INTEGER N, X
      EXTERNAL SUB1
      COMMON /GLOBALS/ N
      X = 0
      PRINT *, 'Enter number of repeats'
      READ (*,*) N
      CALL SUB1(X,SUB1)
      END

      SUBROUTINE SUB1(X,DUMSUB)
      INTEGER N, X
      EXTERNAL DUMSUB
      COMMON /GLOBALS/ N
      IF(X .LT. N)THEN
        X = X + 1
        PRINT *, 'x = ', X
        CALL DUMSUB(X,DUMSUB)
      END IF
      END
I've read in some texts that indirect reference is not allowed, but ask yourself "How can SUB1 possibly know that it's actually calling itself when it calls the dummy subroutine?" It can't, and thus this must work. In fact, on every system I've tried so far, this routine works perfectly. This routine simply asks the user how many times to make SUB1 call itself, and then each time SUB1 is executed it increments X and prints the value after each increment. For N = 5, the following output is produced:
        x = 1
        x = 2
        x = 3
        x = 4
        x = 5

Fortran 90 (and 95), on the other hand, supports recursion directly. Subroutines and functions may call themselves only if they are explicitly declared with the recursive keyword. Here's the same program coded in modern Fortran 90: (Note Fortran 90 can be written in free form and need not start in column 7).

       module module1
       integer:: n
       contains

       recursive subroutine sub1(x)
       integer,intent(inout):: x
       if (x < n) then
         x = x + 1
         print *, 'x = ', x
         call sub1(x)
       end if
       end subroutine sub1

       end module module1

       program main
       use module1
       integer:: x = 0
       print *, 'Enter number of repeats'
       read (*,*) n
       call sub1(x)
       end program main
< rant >
C programmers love to gloat that recursion can not be done in Fortran. When they say Fortran, they mean FORTRAN 77, since they absolutely refuse to acknowledge the existence of modern Fortran 90. (Fortran 90 came out over ten years ago. You would think they might know something about it by now!) But this example shows that even in FORTRAN 77 one can quickly and easily write routines that are recursive. So stick that in your complex variables, C programmers, and -- oh wait, I forgot there are no complex variables in C. You have to manually define a complex data type. Not to mention having to write math functions like sin( ) and cos( ) to handle such data types.
< /rant >

Back to top



Example 2: Behavior of local variables in recursive routines in FORTRAN 77


One must be careful, however, when writing recursive routines that use local variables. In normal recursive routines, local variables should be automatic and not static. In other words, each call of the routine should have its own private copy of all local variables that are not declared with the SAVE statement. The following routine shows how local variables behave in a recursive Fortran 90 routine.
       module module1
       integer:: n
       contains

       recursive subroutine sub1(x)
       integer,intent(inout):: x
       integer:: y
       y = 0
       if (x < n) then
         x = x + 1
         y = x**2
         print *, 'x = ', x,', y = ', y 
         call sub1(x)
         print *, 'x = ', x,', y = ', y 
       end if
       end subroutine sub1

       end module module1

       program main
       use module1
       integer:: x = 0
       print *, 'Enter number of repeats'
       read (*,*) n
       call sub1(x)
       end program main
Executing this program with n = 5 produces the following output:
        x = 1, y = 1
        x = 2, y = 4
        x = 3, y = 9
        x = 4, y = 16
        x = 5, y = 25
        x = 5, y = 25
        x = 5, y = 16
        x = 5, y = 9
        x = 5, y = 4
        x = 5, y = 1
The variable x is an argument of the subroutine and retains the value stored by the fifth call of sub1. The variable y is local to the subroutine and a private copy of y is generated each time sub1 is called. This is the proper behavior for a recursive routine. If y had been given the SAVE attribute or declared with a SAVE statement, y would be a static variable meaning that only one copy of y would be used for all calls to sub1. In this case the output from this example would be:
        x = 1, y = 1
        x = 2, y = 4
        x = 3, y = 9
        x = 4, y = 16
        x = 5, y = 25
        x = 5, y = 0
        x = 5, y = 0
        x = 5, y = 0
        x = 5, y = 0
        x = 5, y = 0
On the sixth call to sub1 y is set to zero, but since x == n, the sixth call of sub1 ends and returns to the fifth call. Since, in this case, y is static, it retains its value of zero stored in the sixth call. If we remove the initial assignment of y from sub1, the output would look like this:
        x = 1, y = 1
        x = 2, y = 4
        x = 3, y = 9
        x = 4, y = 16
        x = 5, y = 25
        x = 5, y = 25
        x = 5, y = 25
        x = 5, y = 25
        x = 5, y = 25
        x = 5, y = 25
Note that in Fortran 90 if one initializes a variable in a type declaration statement e.g. INTEGER:: y = 0, y will be static by default. This is equivalent to INTEGER,SAVE:: y = 0.

When this example is coded in FORTRAN 77 the results are found to be compiler dependent. Here's example 2 in FORTRAN 77:

      PROGRAM MAIN
      INTEGER N, X
      EXTERNAL SUB1
      COMMON /GLOBALS/ N
      X = 0
      PRINT *, 'Enter number of repeats'
      READ (*,*) N
      CALL SUB1(X,SUB1)
      END

      SUBROUTINE SUB1(X,DUMSUB)
      INTEGER N, X, Y
      EXTERNAL DUMSUB
      COMMON /GLOBALS/ N
      Y = 0
      IF(X .LT. N)THEN
        X = X + 1
        Y = X**2
        PRINT *, 'x = ', X, ', y = ', Y
        CALL DUMSUB(X,DUMSUB)
        PRINT *, 'x = ', X, ', y = ', Y
      END IF
      END
Notice that Y is not declared in a SAVE statement. One would hope that this routine behaves as if Y is automatic. And, in fact, when this code is compiled with the ABSOFT FORTRAN 77 Compiler version 4.5 for Mac OS or with the GNU FORTRAN 77 for Linux PPC, Y behaves as if it were automatic. However, when compiled with Microsoft Fortran PowerStation 4.0 (No, I haven't upgraded to Compaq Visual Fortran 6 yet) Y behaves as if it were static. This is because by default the MS Fortran compiler declares all local variables to be static except if the routine is a normal Fortan 90 recursive procedure. With MS Fortan, one can use the AUTOMATIC extension to force Y to be automatic.

Back to top



Example 3: Use of DATA statement in recursive routines in FORTRAN 77


Use of the DATA statement also produces compiler dependent results. Consider the following variation on the Fortran 77 code from example 1:
      PROGRAM MAIN
      INTEGER N, X
      EXTERNAL SUB1
      COMMON /GLOBALS/ N
      X = 0
      PRINT *, 'Enter number of repeats'
      READ (*,*) N
      CALL SUB1(X,SUB1)
      END

      SUBROUTINE SUB1(X,DUMSUB)
      INTEGER N, X, Y
      EXTERNAL DUMSUB
      COMMON /GLOBALS/ N
      DATA Y /0/
      IF(X .LT. N)THEN
        X = X + 1
        Y = Y + 1
        PRINT *, 'x = ', X, ', y = ', Y
        CALL DUMSUB(X,DUMSUB)
      END IF
      END
The only difference is that I have declared a local variable Y in SUB1. I've used a DATA statement to initialize the variable. The question is whether Y is initialized every time SUB1 is called, or only on the first call. When compiled with ABSOFT FORTRAN 77 compiler version 4.5 for Mac OS the following output is generated for N = 5
        x = 1, y = 1
        x = 2, y = 1
        x = 3, y = 1
        x = 4, y = 1
        x = 5, y = 1
indicating that Y is initialize each time SUB1 is invoked. However, when compiled with GNU Fortran 77 for Linux PPC or MS Fortan Powerstation 4.0 with N = 5 we have
        x = 1, y = 1
        x = 2, y = 2
        x = 3, y = 3
        x = 4, y = 4
        x = 5, y = 5
indicating that Y is initialized only on the initial call and its value is retained between calls. One would expect this behavior if Y were listed in a SAVE statement in SUB1. It is likely that the GNU and MS compilers make local variables static when they are used in a DATA statement. There may be compiler options to modify this behavior.

Back to top



Example 4: Summary of local variable behavior on several platforms.

Summary of results of local variable and DATA statement experiment.
Platform Compiler Local Variables are: Supports AUTOMATIC statement Variables in DATA Statement are:
Macintosh OS 9.04 Absoft F77 v4.5 automatic N/A automatic
LinuxPPC 2000 GNU F77 v0.5.24 (g77) automatic N/A static
Windows 9x/NT/2000 Compaq Visual Fortran v6.1 static Yes static
Windows 9x/NT/2000 Microsoft Fortran PowerStation v4.0 static Yes static
SunOS 5.7 Sun WorkShop Compiler 5.0 (f77) static Yes static
AIX v4.3 IBM XL Fortran (f77) static Yes static

Back to top



Example 5: DO Loops in Fortran

April 14, 2002

I got an email asking about looping in Fortran. The primary looping construct in Fortran is the iterative DO loop. Here's an example of the DO loop construct:

       PROGRAM MAIN
       INTEGER I, I_START, I_END, I_INC
       REAL A(100)

       I_START = 1
       I_END = 100
       I_INC = 1
       
       DO I = I_START, I_END, I_INC
       
           A(I) = 0.0E0

       END DO

       END		
In the above example, the do loop initializes all elements of the array A to zero. At the start of the first trip through the loop, the DO-variable I is set to the value stored in I_START. At the start of the next trip, I is incremented by value stored in I_INC. The loop continues while I is less than or equal to the value stored in I_END. This program is equivalent to the following C program:
    int main(void)
    {
        int i, i_start, i_end, i_inc;
        float a[100];

        i_start = 1;
        i_end = 100;
        i_inc = 1;
        
        for (i = i_start; i <= i_end; i += i_inc)
        {
            a[i-1] = 0.0e0;
        }
        
        return 0;
    }
It is important to note that Fortran DO loops are not quite the same as C for loops. In Fortran the DO-variable I cannot be reset within the body of the loop, and should never be referenced outside the loop without first explicitly assigning a value to it. The C for loop exists mainly as a convenience to programmers since it is a pre-test loop like the while loop. If the increment I_INC is not specified, as in the following code fragment, it is assumed to be 1.
       DO I = I_START, I_END
       
           A(I) = 10.0 * A(I)
       
       END DO
The END DO statement is not a part of the official FORTRAN 77 standard, but it is a part of the Fortran 90/95 standards. Most FORTRAN 77 compilers do support the END DO anyway. In older FORTRAN 77 codes DO loops were coded as in the following code fragment:
       DO 10 I = I_START, I_END, I_INC

           A(I) = 10.0 * A(I)
          
10     CONTINUE 
where number 10 after the DO is a Fortran statement lable for the line where the loop ends. Usually the CONTINUE statement is placed on the line marked by the statement label. I'll talk about other looping constructs in fortran in the next example in the future.

Back to top


[A. J. Miller] [ESM] [Grad Students] [PSU Engineering] [Penn State]


This page was last modified on .
© Copyright 2000-2002 by Andrew J. Miller. All rights reserved.