External Functions and Subroutines

Besides the main program and the BLOCK DATA subprogram there are two other kinds of complete program units: the external function and the subroutine. Any FORTRAN 77 statement (except BLOCK DATA and PROGRAM) may appear in these procedures and two statements, RETURN and SAVE, may only appear in them. Both must end with an END statement. The external function returns one value via the name of the function and the subroutine may return zero or more values via an argument list. In a sense, the external function is a specialised form of the subroutine.

Program units are independent in that they have their own symbolic names and labels. They may call each other but cannot call themselves, either directly or indirectly. (This is called recursion and it is not allowed in FORTRAN 77.) Information is passed to and from external procedures via three methods:

External Functions

The first line of an external function declares the type and name of the function, as well as listing the dummy arguments.

type FUNCTION fname(dummy1, dummy2, …, dummyn)

The data type of the function type designates the data type of the value returned by the external function. If it is omitted, then the data type returned is determined by the first letter of the symbolic name fname. If the external function returns a CHARACTER value, then the length must be specified or given as CHARACTER*(*). In this second case, the length will be as specified in the invoking program unit.

The name fname may be used within the external function as a variable but it must be assigned a value before the end of the program unit. The last value assigned to the name fname is the value returned to the invoking program unit.

A function is invoked by using its name fname followed by parentheses and an optional list of arguments called actual arguments which correspond to the dummy arguments in the FUNCTION statement. There may be zero or more dummy arguments of any data type which are declared (if necessary) in the body of the external function. However, the parentheses must be present even if there are no arguments.

Example

Consider the following program consisting of a main program and an external function.

      PROGRAM MAIN
      INTEGER   I,N,NMAX
      PARAMETER(NMAX=10)
      REAL      COEF(0:NMAX),HORNER,X

   10 CONTINUE
         WRITE(*,*)'Enter the degree of the polynomial'
         READ(*,*)N
      IF (N .GT. NMAX) THEN
         WRITE(*,*)'Degree too large.  Choose smaller value.'
         GO TO 10
      END IF
      WRITE(*,*)'Enter the coefficients in ascending order'
      DO 20, I = 0,N
         WRITE(*,*)'Enter the value for coefficient ',I
         READ(*,*)COEF(I)
   20 CONTINUE
      WRITE(*,*)'Enter the value of X'
      READ(*,*)X
      WRITE(*,*)'The value of the polynomial at ',X,' is ',
     $          HORNER(COEF,N,X)
      STOP 'End of program'
      END

      REAL FUNCTION HORNER(A,N,X)
C This function returns the value of the polynomial 
C y = a_0 + a_1 x + a_2 x^2 + … + a_n x^n
C using Horner's method.
      INTEGER I,N
      REAL    A(0:N),X

      HORNER = A(N)
      D0 10 I = N-1,0,-1
         HORNER = A(I) + HORNER*X
   10 CONTINUE
      END

In this example, COEF, N and X are the actual arguments in the function reference in the main program and A, N and X are the dummy arguments in the FUNCTION statement. The main program invokes the function in a WRITE statement.

Side Effects

An external function is supposed to return exactly one value via the function name. However, it is permitted for the function to have 'side effects', that is, for the function to alter the values of the actual arguments or of variables appearing in COMMON blocks. However, there are many restrictions on how a function with side effects can be used in a program so if it is necessary to alter arguments or variables in COMMON blocks, it is best to use a subroutine instead.

Subroutines

The first line of a subroutine gives the name of the program unit and a listing of the dummy arguments. Unlike an external function, a subroutine does not have a data type because a subroutine returns any values through its argument list, not through its name.

SUBROUTINE subname(dummy1, dummy2, …, dummyn)

There may be zero or more dummy arguments of any data type which are declared (if necessary) in the body of the subroutine. Unlike external functions, however, the parentheses may be omitted if there are no dummy arguments.

Because the symbolic name subname is global in nature, it may not be used as a variable within the subroutine.

A subroutine is invoked with a CALL statement in the invoking program unit.

CALL subname(arg1, arg2, …, argn)

The arguments argi in the CALL statment are known as actual arguments (as opposed to the dummy arguments which appear in the SUBROUTINE statement). If the subroutine has no arguments, then the CALL statement is simply

CALL subname

Example

Consider the following program consisting of a main program and a subroutine.

      PROGRAM MAIN
      REAL TIME,H,M,S

   10 CONTINUE
         WRITE(*,*)'Enter the time in decimal hours'
         READ(*,*,END=999)TIME
         IF (TIME .LT. 0.0) GO TO 999
         CALL CONVRT(TIME,H,M,S)
         WRITE(*,20)TIME,H,M,S
   20    FORMAT(' ',F9.2,' hours = ',I6,' h ',I2,' m ',F5.2,' s')
      GO TO 10
  999 STOP 'End of program'
      END

      SUBROUTINE CONVRT(DTIME,HOURS,MINS,SECS)
C This subroutine converts DTIME (time in decimal hours) to individual 
C hours, minutes and seconds
      INTEGER HOURS, MINS
      REAL    DSECS,DTIME,SECS

C Convert DTIME from decimal hours to decimal seconds for ease of calculation.
      DSECS = DTIME*3600.0
C Calculate individual hours, minutes and seconds.
      HOURS = INT(DTIME)
      SECS  = DSECS - 3600.0*HOURS
      MINS  = INT(SECS/60.0)
      SECS  = SECS - 60.0*MINS
      END

The main program consists of a repeat-until loop which is stopped if the user enters a negative value or the EOF character. (The EOF is system dependent but should be something like <CTRL>C, <CTRL>D or <CTRL>Z.) If a legal value is input for the variable TIME, the subroutine CONVRT is called with four arguments. The first argument, TIME, already has a value when the subroutine is called. The other three arguments, H, M and S, will receive their values in the subroutine. After the CALL statement is executed, the WRITE statement outputs the results of the calculations in the subroutine and the loop repeats.

The subroutine CONVRT begins with the SUBROUTINE statement and assorted variable type declarations. One of the variables, DSECS, is local to the subroutine but the rest are the arguments in the dummy argument list. The first value in the dummy argument list is passed to the subroutine from the calling program. Several calculations take place and values are assigned to the other three arguments which are passed back to the calling program at the end of the subroutine.

In this example, TIME, H, M and S are actual arguments in the CALL statement in the main program. DTIME, HOURS, MINS and SECS are the corresponding dummy arguments in the SUBROUTINE statement.

Arguments

One method for passing information between program units is via an argument list. The list of dummy (or formal) arguments is specified in the FUNCTION and SUBROUTINE statements in the external procedure. There may be zero or more dummy arguments in the list. If there are no arguments, then the parentheses may be omitted from the CALL and SUBROUTINE statements but not from the function reference and the FUNCTION statements.

Dummy arguments may be constants, variables, arrays, procedures or labels. Dummy arguments may not appear in COMMON blocks, DATA statements, EQUIVALENCE statements or SAVE statements.

The actual arguments in the function reference or CALL statement are associated in a one-to-one fashion with the dummy arguments in the external procedure, subject to the following restrictions:

Because program units are compiled separately, the compiler is unlikely to detect mismatched argument lists. This is a common source of run-time errors.

Variables, constants and expressions as arguments

If a dummy argument is a variable which has a value assigned to it in the procedure, then the corresponding actual argument may be a variable, an array element or a character substring. However, if the dummy argument does not alter any input value, then the corresponding actual argument may also be a constant or expression.

Example

Consider this snippet of code consisting of a main program and a subroutine:

      PROGRAM MAIN
      INTEGER M,N

      M = 5
      N = 20
      CALL ADD(M,N)
      END

      SUBROUTINE ADD(I,J)
      INTEGER I,J
      J = I + J
      END

In this example, M and N are assigned values in the main program and passed to the subroutine ADD. The subroutine adds the two values and returns the sum in the second argument in the list. Thus, before the subroutine call, M = 5 and N =20 but after the subroutine call, N has been altered to the number 25.

Now consider a slightly different example.

      PROGRAM MAIN
      INTEGER N

      N = 20
      CALL ADD(5,N)
      END

      SUBROUTINE ADD(I,J)
      INTEGER I,J
      J = I + J
      END

The program works in exactly the same way although in this case, the first actual argument is a constant, the number 5. Since the first dummy argument is not altered in the subroutine, this is perfectly legal.

What happens in this case?

      PROGRAM MAIN
      INTEGER M

      M = 5
      CALL ADD(M,20)
      END

      SUBROUTINE ADD(I,J)
      INTEGER I,J
      J = I + J
      END

The second actual argument is a constant (the number 20) but the value of the second dummy argument is altered in the subroutine. What happens next is system-dependent. Some systems will detect that the program is attempting to overwrite a constant and stop with an error message, but other systems will actually overwrite the constant 20 with 25 so that anywhere you try to use the value 20, you will actually be using 25. Such errors are nearly impossible to track down so be careful when passing constants as actual arguments.

If the actual argument is an expression, that expression is evaluated before the procedure is referenced or called. As in the case with constant actual arguments, you should not attempt to alter the value of the corresponding dummy argument.

Example

      CALL EVAL(N,I**ABS(N),RESULT)

The second actual argument, I**ABS(N), is evaluated before the subroutine EVAL is called. The corresponding dummy argument should be an input argument only and not get altered in the subroutine.

CHARACTER variables may be passed to a procedure along with another variable denoting their lengths but it is usually preferable to have the computer set the length automatically using the *(*) length specification in the procedure. When this is used, the length of the dummy CHARACTER argument is automatically set equal to the length of the actual CHARACTER argument.

Example

      PROGRAM MAIN
…
      CALL INPUT('model01.dat',M,N,RADIUS,DENSE,X)
…
      END

      SUBROUTINE INPUT(FNAME,NMAX,N,R,RHO,X)
      CHARACTER*(*)    FNAME
      INTEGER          N,NMAX
      DOUBLE PRECISION R(0:NMAX),RHO(0:NMAX),X(0:NMAX)

      OPEN(1,FILE=FNAME,STATUS='OLD',ERR=900)
…
      END

The dummy argument FNAME is of type CHARACTER and is of length 11, the same size as the corresponding actual argument, the CHARACTER constant model01.dat.

Arrays as arguments

If a dummy argument is an array, then the corresponding actual argument must either be an array name (without a subscript) or an array element (with a subscript). In the first instance, the entire array is passed. In the second, only part of the array is passed, starting with the position denoted in the actual argument.

Example

Consider a program consisting of main program unit and a subroutine which multiplies element-wise two arrays of length 100 and returns the product in a third array.

      PROGRAM MAIN
      REAL A(100),B(100),C(100)
…
      CALL MULT(A,B,C)
…
      END

      SUBROUTINE MULT(X,Y,Z)
      INTEGER I
      REAL    X(100),Y(100),Z(100)

      DO 10, I = 1,100
         Z(I) = X(I)*Y(I)
   10 CONTINUE
      END

In this example, entire arrays are passed to and from the subroutine.

It is more often the case that the dimension of the array is also passed with the array name. This makes the procedure more generalised so that it can work on arrays of any size. When an array appearing in the dummy argument list of in an external procedure is declared using an input value for the dimension, this is known as an adjustable size declaration. Note that adjustable size declarations can be made only for arrays appearing as dummy arguments in external procedures, not for arrays which are local to the proceudre. Also note that the variables being used as array dimensions must be declared as INTEGERs before they are used in the adjustable size declaration.

Example

      PROGRAM MAIN
      INTEGER   N,NMAX
      PARAMETER(NMAX=100)
      REAL      A(NMAX),B(NMAX),C(NMAX)
…
      CALL MULT(N,A,B,C)
…
      END

      SUBROUTINE MULT(SIZE,X,Y,Z)
      INTEGER I,SIZE
      REAL    X(SIZE),Y(SIZE),Z(SIZE)

      DO 10, I = 1,SIZE
         Z(I) = X(I)*Y(I)
   10 CONTINUE
      END

In this example, the actual array size N (which may be less than or equal to the maximum-allowed size NMAX) is passed to the subroutine along with the array names. Now the procedure will work on any size array.

Sometimes it isn't known ahead of time how large the array will be. Either the maximum size of the array can be passed to the procedure or the array appearing in the dummy argument list can be declared as an assumed size array. In this instance, the upper bound of the last dimension of the array may be declared using as asterisk *

Example

      SUBROUTINE DERIV(X,H,N)
      INTEGER N
      REAL    H,X(*)

      X(N) = (X(N+1) - X(N-1))/(2.0*H)
      END

All that is known about array X is that its lower bound (or subscript) is 1. It is up to the programmer to ensure that the subroutine is never called if the value of N is out-of-bounds.

All of these discussions hold for multi-dimensional arrays and arrays whose lower bound is not 1. Multi-dimensional arrays are a little tricky; it is usually sensible to pass the declared sizes of the arrays to the procedure in order to preserve the storage scheme of the array. Only the upper bound of the last dimension may be assumed size or less than the actual declared size.

Example

      PROGRAM MAIN
      INTEGER   MMAX,NMAX,M,N
      PARAMETER(MMAX=4,NMAX=3)
      REAL      A(MMAX,NMAX),X(NMAX),Y(MMAX)
…
      CALL MATVEC(MMAX,M,N,A,X,Y)
…
      END

      SUBROUTINE MATVEC(DIM1,M,N,MATRIX,VECX,VECY)
C Multiply a matrix by a vector.
      INTEGER DIM1,I,M,N
      READ    SUM,MATRIX(DIM1,*),VECX(*),VECY(*)

      DO 20, I = 1,M
         SUM = 0.0
         DO 10, J = 1,N
            SUM = SUM + MATRIX(I,J)*VECX(J)
   10    CONTINUE
         VECY(I) = SUM
   20 CONTINUE
      END

In the subroutine, the first dimension of the two-dimensional array is set to the declared size in the main program. This will preserve the integrity of the storage scheme.

Main Subroutine Main Subroutine Main Subroutine
A(1,1) MATRIX(1,1) X(1) VECX(1) Y(1) VECY(1)
A(2,1) MATRIX(2,1) X(2) VECX(2) Y(2) VECY(2)
A(3,1) MATRIX(3,1) X(3) VECX(3) Y(3) VECY(3)
A(4,1) MATRIX(4,1) Y(4) VECY(4)
A(1,2) MATRIX(1,2)
A(2,2) MATRIX(2,2)
A(3,2) MATRIX(3,2)
A(4,2) MATRIX(4,2)
A(1,3) MATRIX(1,3)
A(2,3) MATRIX(2,3)
A(3,3) MATRIX(3,3)
A(4,3) MATRIX(4,3)

It is possible to transfer sections of arrays by using array elements in the actual argument list and array names in the dummy argument list. This works because FORTRAN 77 passes arguments by reference rather than by value. That is to say, it is the storage address of the symbolic name that is passed, not the actual value(s) stored in the symbolic name.

Example

      PROGRAM MAIN
      INTEGER   NMAX
      PARAMETER(NMAX=5)
      DOUBLE PRECISION ARRAY(-NMAX:NMAX)
…
      CALL FLUMOX(ARRAY(-2))
…
      END

      SUBROUTINE FLUMOX(A)
      DOUBLE PRECISION A(*)
…
      END

In this example, the actual argument is an array element and the dummy argument is an array. What is passed to the subroutine is the address of storage space of ARRAY(2) and what the subroutine sees is this:

Main Subroutine
ARRAY(-5)
ARRAY(-4)
ARRAY(-3)
ARRAY(-2) A(1)
ARRAY(-1) A(2)
ARRAY(0) A(3)
ARRAY(1) A(4)
ARRAY(2) A(5)
ARRAY(3) A(6)
ARRAY(4) A(7)
ARRAY(5) A(8)

So only a part of the array is transferred and the subroutine effectively thinks it's getting an array with 8 elements in it, starting with the storage space assigned to ARRAY(-2) in the main program.

This can make your code rather obscure so use this trick with caution.

Procedures as arguments

EXTERNAL Statement

The EXTERNAL statement names external procedures which are required in order to run a given program unit. It is required any time an external procedure or dummy procedure is used as an actual argument of another procedure call. It is also necessary when calling a user-defined procedure which has the same name as an intrinsic function. The general form of the statement is

EXTERNAL ename1, ename2, …, enamen

where ename is the name of an external function, subroutine or dummy procedure in an argument list.

Example

Consider the following program fragment consisting of a main program, a user-defined function POLY and a subroutine BISECT. The main program calls the subroutine BISECT with the function POLY as an actual argument.

      PROGRAM MAIN
      REAL A,B,EPS,POLY,X
      EXTERNAL POLY
…
      CALL BISECT(POLY,A,B,X,EPS)
…
      END

      REAL FUNCTION POLY(X)
      REAL X
      POLY = X**2 - X - 2.0
      END

      SUBROUTINE BISECT(FUNC,XLOWER,XUPPER,XZERO,TOL)
C This subroutine uses the bisection method to find a known root of the 
C external user-supplied function FUNC in the interval [XLOWER,XUPPER].
C The root is returned in XZERO.  The tolerance for the interval size is
C TOL and is defined by the calling program unit.
      INTEGER   I,NMAX
      REAL      FUNC,FX,TOL,XL,XLOWER,XU,XUPPER,XZERO
      PARAMETER(NMAX=25)

C Error trapping for incorrect interval.
      IF (XLOWER .GE. XUPPER) THEN
         WRITE(*,*)'Incorrect interval. No zero found.'
         RETURN
      END IF
C Initialise local copies of bounds so original values are unaltered.
      XL = XLOWER
      XU = XUPPER
C Bisection method.  Perform at most NMAX iterations.
      DO 10, I = 1,NMAX
C Set midpoint of current interval and evaluate function at midpoint.
         XZERO = 0.5*(XL + XU)
         FX    = FUNC(XZERO)
C If root is found or interval is 'small enough', return.
         IF (FX .EQ. 0.0 .OR. 0.5*(XU-XL) .LT. TOL) THEN
            RETURN
C Root is in the lower half of the current interval.
         ELSE IF (FX*FUNC(XL) .LT. 0.0) THEN
            XU = XZERO
C Root is in the upper half of the current interval.
         ELSE
            XL = XZERO
         END IF
   10 CONTINUE
      WRITE(*,*)'WARNING: Tolerance not met after ',NMAX,' iterations'
      END

Because POLY is the name of an external function and it appears as an actual argument in the CALL BISECT statement in the main program, it has to be declared as EXTERNAL in the main program.

INTRINSIC Statement

The INTRINSIC statement is related to the EXTERNAL statement. It is used to declare a name to be that of an intrinsic function but is necessary only if that function is used as an actual argument in another procedure call. The general form of the statement is

INTRINSIC iname1, iname2, …, inamen

where iname is the name of an intrinsic function.

The name of the intrinsic function being used as an actual argument must be the specific name of the function and not the generic name. Only some of the numerical functions have specific names. The other functions, such as those for type conversion as well as MAX and MIN, do not have specific names and cannot appear in argument lists.

Example

      PROGRAM MAIN
      REAL      PI
      PARAMETER(PI=3.14159265)
      INTRINSIC COS,SIN

      WRITE(*,*)'Cosine Function'
      CALL TABLE(COS,-PI,PI)
      WRITE(*,*)'PAUSE: Press <Enter> to continue'
      READ(*,*)
      WRITE(*,*)'Sine Function'
      CALL TABLE(SIN,-PI,PI)
      STOP 'End of program'
      END

      SUBROUTINE TABLE(F,LOWER,UPPER)
      INTEGER   I,NMAX
      REAL      DELTAX,F,LOWER,UPPER,X
      PARAMETER(NMAX = 100)

      DELTAX = (UPPER - LOWER)/NMAX
      DO 10, I = 0,NMAX
         X = LOWER + I*DELTAX
         WRITE(*,20)X,F(X)
   10 CONTINUE
   20 FORMAT(' ',F10.6,2X,F10.6)
      END

The intrinsic functions COS and SIN are passed to a subroutine called TABLE and so must be declared as INTRINSIC in the calling program unit (the main program in this case). Note that COS and SIN are the specific names of the REAL intrinsic functions of cosine and sine.

RETURN Statement

The RETURN statement is simply

RETURN

without any arguments or qualifiers. When encountered in a procedure, it immediately transfers execution back to the calling program. The END statement also has the same effect so it is unnecessary (although not incorrect) to include a RETURN statement at the bottom of a procedure. However, sometimes it is necessary to have more than one exit point from a procedure, perhaps for error-trapping purposes.

Example

      SUBROUTINE QUAD(A,B,C,X1,X2,FLAG)
C This subroutine calculates the real roots of the quadratic equation 
C a x^2 + b x + c = 0
C using the method of Forsythe, Malcolm and Moler to avoid catastrophic 
C floating point cancellation.  If the equation is linear or if complex 
C roots are encountered, the error flag is set to TRUE and no roots are 
C calculated.
      LOGICAL FLAG
      REAL    A,B,C,DISC,X1,X2

C Calculate discriminant.
      DISC = B*B - 4.0*A*C
C Set error flag.
      FLAG = DISC .LT. 0.0 .OR. A .EQ. 0.0
C If error flag is TRUE, return early.
      IF (FLAG) THEN
         WRITE(*,*)'ERROR!  Complex roots or non-quadratic equation.'
         RETURN
      END IF
C Otherwise, calculate roots.
      X1 = - (B + SIGN(SQRT(DISC),B))/(2.0*A)
      X2 = C/(A*X1)
      END

In this subroutine, the subroutine exits early if an error occurs. Otherwise, execution returns to the calling program when the END statement is reached.

SAVE Statement

Under normal circumstances, local variables declared within a procedure become undefined as soon as control passes back to the calling program. However, it is sometimes useful or even necessary to preserve the values of the local variables between calls or references to the procedure. This is done with the SAVE command.

SAVE item1, item2, …, itemn

saves the values of each itemi listed and

SAVE

saves the values of all allowable items in the procedure. The items may be variables, array names or entire named COMMON blocks but not anything which appears as a dummy argument or in a blank COMMON block. The SAVE statement also may be used in the main program but it has no effect.

Example

      SUBROUTINE MODEL(A,B,C,X,Y,Z)
…
      LOGICAL FIRST
      SAVE    FIRST
      DATA    FIRST /.TRUE./

C Execute this block only the first time the subroutine is called.
      IF (FIRST) THEN
         FIRST = .FALSE.
…
      END IF
C Execution starts here on subsequent calls to the subroutine.
…
      END

In this example, there is a certain block of statements which must be executed the first time the subroutine is called but not on subsequent calls. To do this, a local LOGICAL variable called FIRST is initialised to .TRUE. in a DATA statement so that it has appropriate value the first time the subroutine is called. On the first call to the subroutine, the block IF is executed, one of the statements being FIRST = .FALSE. Local variables become undefined as soon as the subroutine is exited but the SAVE statement keeps the current value of FIRST between calls to the subroutine. The block IF statement will not execute on any call to the subroutine except the first.

ENTRY Statement

A function or subroutine is usually entered at the beginning of the program unit but it is possible to enter them at other points using the ENTRY statement. The ENTRY statement is a nonexecutable statement which looks very much like a SUBROUTINE statement and may occur one or more times within a subroutine or external function. It may not appear within a DO loop or block IF construct as this would have the effect of jumping into the middle of these structures (which is not allowed).

ENTRY ename(dummy1, dummy2, …, dummyn)

This statement is difficult to use correctly and its use is strongly discouraged.

Example

Consider the program fragment:

      PROGRAM MAIN
      REAL A,B,C,D,E,F
…
      CALL SUB(A)
…
      CALL SUB1(B,C)
…
      CALL SUB2(D,E,F)
…
      END

      SUBROUTINE SUB(X)
      REAL X,Y,Z
      WRITE(*,*)'The value of X is ',X
      RETURN
      ENTRY SUB1(X,Y)
      X = X + Y
      RETURN
      ENTRY SUB2(X,Y,Z)
      X = X + Y + Z
      RETURN
      END      

In the subroutine SUB, the names SUB1 and SUB2 define alternate entry points to the subroutine. If the subroutine is called in the usual manner, then the first executable statement is WRITE(*,*)'The value of X is ',X. However, if the subroutine is called at the entry point SUB1, then the first executable statement is X = X + Y. Similarly, if the subroutine is called at the entry point SUB2, then the first executable statement is X = X + Y + Z.

The rules for using the ENTRY statement are complicated, particularly in external functions. It is usually better to use separate subroutines or functions than to create multiple entry points in a single subroutine or external function.

Alternate RETURN Statement

Not only is it possible to enter a subroutine in different places, it is possible to return from a subroutine in different places via the alternate RETURN statement. The alternate RETURN returns control to the calling program unit to a labelled statement after the completion of the CALL statement. Note that the alternate RETURN may be used in subroutines but not external functions.

RETURN integer

This statement leads to a lack of modularity and its use is strongly discouraged.

Example

Consider the program fragment:

      PROGRAM MAIN
…
      CALL CONFUS(A,B,C,*13,*66,*42)
…
   13 A = -A
…
   42 WRITE(*,*)'Default return'
…
   66 B = A - C
…
      END

      SUBROUTINE CONFUS(X,Y,Z,*,*,*)
…
      IF (X .LT. 0.0) RETURN 2
…
      END

In the main program, the subroutine CONFUS is called with six arguments: A, B, C and three statement labels, each preceded by an asterisk *. The subroutine also contains six arguments, X, Y, Z and three asterisks * which correspond to the three label arguments in the calling program. In the subroutine, if X < 0, then control is passed back to the main program and execution resumed at the statement associated with the second label in the argument list. In this example, that is the statement with the label 66 which is B = A - C.

If none of the alternate RETURN statements are used (RETURN 1, RETURN 2 and RETURN 3 in the given example), then control will be returned to the main program in the usual way.

The alternate RETURN can easily be replaced with some kind of INTEGER flag which is returned via the argument list and an IF statement in the calling program which decides what action to take according to the status of the flag.