[an error occurred while processing this directive]

HP OpenVMS Systems Documentation

Content starts here

HP Fortran for OpenVMS
Language Reference Manual


Previous Contents Index

The following example shows an assumed-length character function:


CHARACTER*(*) FUNCTION REDO(CARG)
  CHARACTER*1 CARG
  DO I=1,LEN(REDO)
    REDO(I:I) = CARG
  END DO
  RETURN
END FUNCTION

This function returns the value of its argument, repeated to fill the length of the function.

Within any given program unit, all references to an assumed-length character function must have the same length. In the following example, the REDO function has a length of 1000:


CHARACTER*1000 REDO, MANYAS, MANYZS
MANYAS = REDO('A')
MANYZS = REDO('Z')

Another program unit within the executable program can specify a different length. For example, the following REDO function has a length of 2:


CHARACTER HOLD*6, REDO*2
HOLD = REDO('A')//REDO('B')//REDO('C')

The following example shows a dynamic array-valued function:


FUNCTION SUB (N)
  REAL, DIMENSION(N) :: SUB
  ...
END FUNCTION

For More Information:

8.5.2.1 RESULT Keyword

Normally, a function result is returned in the function's name, and all references to the function name are references to the function result.

However, if you use the RESULT keyword in a FUNCTION statement, you can specify a local variable name for the function result. In this case, all references to the function name are recursive calls, and the function name must not appear in specification statements.

The RESULT name must be different from the name of the function.

The following shows an example of a recursive function specifying a RESULT variable:


RECURSIVE FUNCTION FACTORIAL(P) RESULT(L)
  INTEGER, INTENT(IN) :: P
  INTEGER L
  IF (P == 1) THEN
    L = 1
  ELSE
    L = P * FACTORIAL(P - 1)
  END IF
END FUNCTION

8.5.2.2 Function References

Functions are invoked by a function reference in an expression or by a defined operation.

A function reference takes the following form:


  • fun ([a-arg [,a-arg]...])

fun

Is the name of the function subprogram.

a-arg

Is an actual argument optionally preceded by [keyword=], where keyword is the name of a dummy argument in the explicit interface for the function. The keyword is assigned a value when the procedure is invoked.

Each actual argument must be a variable, an expression, or the name of a procedure. (It must not be the name of an internal procedure, statement function, or the generic name of a procedure.)

Rules and Behavior

When a function is referenced, each actual argument is associated with the corresponding dummy argument by its position in the argument list or by the name of its keyword. The arguments must agree in type and kind parameters.

Execution of the function produces a result that is assigned to the function name or to the result name, depending on whether the RESULT keyword was specified.

The program unit uses the result value to complete the evaluation of the expression containing the function reference.

If positional arguments and argument keywords are specified, the argument keywords must appear last in the actual argument list.

If a dummy argument is optional, the actual argument can be omitted.

If a dummy argument is specified with the INTENT attribute, its use may be limited. A dummy argument whose intent is not specified is subject to the limitations of its associated actual argument.

An actual argument associated with a dummy procedure must be the specific name of a procedure, or be another dummy procedure. Certain specific intrinsic function names must not be used as actual arguments (see Table 9-1).

Examples

Consider the following example:


X = 2.0
NEW_COS = COS(X)        ! A function reference

Intrinsic function COS calculates the cosine of 2.0. The value --0.4161468 is returned (in place of COS(X)) and assigned to NEW_COS.

For More Information:

8.5.3 Subroutines

A subroutine subprogram is invoked in a CALL statement or by a defined assignment statement, and does not return a particular value.

The SUBROUTINE statement is the initial statement of a subroutine subprogram. It takes the following form:


  • [prefix] SUBROUTINE name [([d-arg-list])]

prefix

Is one of the following:
Keyword Meaning
RECURSIVE Permits direct recursion to occur (see Section 8.5.1.1).
PURE Asserts that the procedure has no side effects (see Section 8.5.1.2).
ELEMENTAL Restricted form of pure procedure that acts on one array element at a time (see Section 8.5.1.3).

name

Is the name of the subroutine.

d-arg-list

Is a list of one or more dummy arguments or alternate return specifiers (*).

Rules and Behavior

A subroutine is invoked by a CALL statement or defined assignment. When a subroutine is invoked, dummy arguments (if present) become associated with the corresponding actual arguments specified in the call.

Execution begins with the first executable construct or statement following the SUBROUTINE statement. Control returns to the calling program unit once the END statement (or a RETURN statement) is executed.

A subroutine subprogram cannot contain a FUNCTION statement, a BLOCK DATA statement, a PROGRAM statement, or another SUBROUTINE statement. ENTRY statements can be included to provide multiple entry points to the subprogram.

Examples

The following example shows a subroutine:

Main Program Subroutine
CALL HELLO_WORLD SUBROUTINE HELLO_WORLD
... PRINT *, "Hello World"
END END SUBROUTINE

The following example uses alternate return specifiers to determine where control transfers on completion of the subroutine:

Main Program Subroutine
CALL CHECK(A,B,*10,*20,C) SUBROUTINE CHECK(X,Y,*,*,Q)
TYPE *, 'VALUE LESS THAN ZERO' ...
GO TO 30 50 IF (Z) 60,70,80
10 TYPE*, 'VALUE EQUALS ZERO' 60 RETURN
GO TO 30 70 RETURN 1
20 TYPE*, 'VALUE MORE THAN ZERO' 80 RETURN 2
30 CONTINUE END
...  

The SUBROUTINE statement argument list contains two dummy alternate return arguments corresponding to the actual arguments *10 and *20 in the CALL statement argument list.

The value of Z determines the return, as follows:

  • If Z < zero, a normal return occurs and control is transferred to the first executable statement following CALL CHECK in the main program.
  • If Z == zero, the return is to statement label 10 in the main program.
  • If Z > zero, the return is to statement label 20 in the main program.

(An alternate return is an obsolescent feature in Fortran 95 and Fortran 90.)

For More Information:

8.5.4 Statement Functions

A statement function is a procedure defined by a single statement in the same program unit in which the procedure is referenced. It takes the following form:


  • fun ([d-arg [,d-arg]...]) = expr

fun

Is the name of the statement function.

d-arg

Is a dummy argument. A dummy argument can appear only once in any list of dummy arguments, and its scope is local to the statement function.

expr

Is a scalar expression defining the computation to be performed.

Named constants and variables used in the expression must have been declared previously in the specification part of the scoping unit or made accessible by use or host association.

If the expression contains a function reference, the function must have been defined previously in the same program unit.

A statement function reference takes the following form:


  • fun ([a-arg [,a-arg]...])

fun

Is the name of the statement function.

a-arg

Is an actual argument.

Rules and Behavior

When a statement function reference appears in an expression, the values of the actual arguments are associated with the dummy arguments in the statement function definition. The expression in the definition is then evaluated. The resulting value is used to complete the evaluation of the expression containing the function reference.

The data type of a statement function can be explicitly defined in a type declaration statement. If no type is specified, the type is determined by implicit typing rules in effect for the program unit.

Actual arguments must agree in number, order, and data type with their corresponding dummy arguments.

Except for the data type, declarative information associated with an entity is not associated with dummy arguments in the statement function; for example, declaring an entity to be an array or to be in a common block does not affect a dummy argument with the same name.

The name of the statement function cannot be the same as the name of any other entity within the same program unit.

Any reference to a statement function must appear in the same program unit as the definition of that function.

A statement function reference must appear as (or be part of) an expression. The reference cannot appear on the left side of an assignment statement.

A statement function must not be provided as a procedure argument.

Examples

The following are examples of statement functions:


REAL VOLUME, RADIUS
VOLUME(RADIUS) = 4.189*RADIUS**3

CHARACTER*10 CSF,A,B
CSF(A,B) = A(6:10)//B(1:5)

The following example shows a statement function and some references to it:


AVG(A,B,C) = (A+B+C)/3.
...
GRADE = AVG(TEST1,TEST2,XLAB)
IF (AVG(P,D,Q) .LT. AVG(X,Y,Z)) STOP
FINAL = AVG(TEST3,TEST4,LAB2)       ! Invalid reference; implicit
...                                 ! type of third argument does not
...                                 ! match implicit type of dummy argument

Implicit typing problems can be avoided if all arguments are explicitly typed.

The following statement function definition is invalid because it contains a constant, which cannot be used as a dummy argument:


REAL COMP, C, D, E
COMP(C,D,E,3.) = (C + D - E)/3.

For More Information:

8.6 External Procedures

External procedures are user-written functions or subroutines. They are located outside of the main program and can't be part of any other program unit.

External procedures can be invoked by the main program or any procedure of an executable program.

In Fortran 95/90, external procedures can include internal procedures, as long as the internal procedures appear between a CONTAINS statement and the end of the procedure.

An external procedure can reference itself (directly or indirectly).

The interface of an external procedure is implicit unless an interface block is supplied for the procedure.

For More Information:

  • On function and subroutine subprograms, see Section 8.5.
  • On procedure interfaces, see Section 8.9.
  • On passing arguments, see the HP Fortran for OpenVMS User Manual.

8.7 Internal Procedures

Internal procedures are functions or subroutines that follow a CONTAINS statement in a program unit. The program unit in which the internal procedure appears is called its host.

Internal procedures can appear in the main program, in an external subprogram, or in a module subprogram.

An internal procedure takes the following form:


  • CONTAINS
  • internal-subprogram
  • [internal-subprogram]...

internal-subprogram

Is a function or subroutine subprogram that defines the procedure. An internal subprogram must not contain any other internal subprograms.

Rules and Behavior

Internal procedures are the same as external procedures, except for the following:

  • Only the host program unit can use an internal procedure.
  • An internal procedure has access to host entities by host association; that is, names declared in the host program unit are useable within the internal procedure.
  • In Fortran 95/90, the name of an internal procedure must not be passed as an argument to another procedure. However, HP Fortran allows an internal procedure name to be passed as an actual argument to another procedure.
  • An internal procedure must not contain an ENTRY statement.

An internal procedure can reference itself (directly or indirectly); it can be referenced in the execution part of its host and in the execution part of any internal procedure contained in the same host (including itself).

The interface of an internal procedure is always explicit.

Every HPF internal subprogram must be of the same extrinsic kind as its host, and any internal subprogram whose extrinsic kind is not given explicitly is assumed to be of that extrinsic kind.

Examples

The following example shows an internal procedure:


PROGRAM COLOR_GUIDE
...
CONTAINS
  FUNCTION HUE(BLUE)   ! An internal procedure
  ...
  END FUNCTION HUE
END PROGRAM

For More Information:

8.8 Argument Association

Procedure arguments provide a way for different program units to access the same data.

When a procedure is referenced in an executable program, the program unit invoking the procedure can use one or more actual arguments to pass values to the procedure's dummy arguments. The dummy arguments are associated with their corresponding actual arguments when control passes to the subprogram.

In general, when control is returned to the calling program unit, the last value assigned to a dummy argument is assigned to the corresponding actual argument.

An actual argument can be a variable, expression, or procedure name. The type and kind parameters, and rank of the actual argument must match those of its associated dummy argument.

A dummy argument is either a dummy data object, a dummy procedure, or an alternate return specifier (*). Except for alternate return specifiers, dummy arguments can be optional.

If argument keywords are not used, argument association is positional. The first dummy argument becomes associated with the first actual argument, and so on. If argument keywords are used, arguments are associated by the keyword name, so actual arguments can be in a different order than dummy arguments.

A keyword is required for an argument only if a preceding optional argument is omitted or if the argument sequence is changed.

A scalar dummy argument can be associated with only a scalar actual argument.

If a dummy argument is an array, it must be no larger than the array that is the actual argument. You can use adjustable arrays to process arrays of different sizes in a single subprogram.

A dummy argument referenced as a subprogram must be associated with an actual argument that has been declared EXTERNAL or INTRINSIC in the calling routine.

If a scalar dummy argument is of type character, its length must not be greater than the length of its associated actual argument.

If the character dummy argument's length is specified as *(*) (assumed length), it uses the length of the associated actual argument.

Once an actual argument has been associated with a dummy argument, no action can be taken that affects the value or availability of the actual argument, except indirectly through the dummy argument. For example, if the following statement is specified:


CALL SUB_A (B(2:6), B(4:10))

B(4:6) must not be defined, redefined, or become undefined through either dummy argument, since it is associated with both arguments. However, B(2:3) is definable through the first argument, and B(7:10) is definable through the second argument.

Similarly, if any part of the actual argument is defined through a dummy argument, the actual argument can only be referenced through that dummy argument during execution of the procedure. For example, if the following statements are specified:


MODULE MOD_A
  REAL :: A, B, C, D
END MODULE MOD_A

PROGRAM TEST
  USE MOD_A
  CALL SUB_1 (B)
  ...
END PROGRAM TEST

SUBROUTINE SUB_1 (F)
  USE MOD_A
  ...
  WRITE (*,*) F
END SUBROUTINE SUB_1

Variable B must not be directly referenced during the execution of SUB_1 because it is being defined through dummy argument F. However, B can be indirectly referenced through F (and directly referenced when SUB_1 completes execution).

The following sections provide more details on arguments:

For More Information:


Previous Next Contents Index