The first statement of an interface block. Interface blocks define
explicit interfaces for external or dummy procedures. They can
also be used to define a generic name for procedures, a new
operator for functions, and a new form of assignment for
subroutines. Format:
INTERFACE [spec]
[body]...
[MODULE PROCEDURE nam]...
END INTERFACE [spec]
spec Is one of the following:
A generic name
OPERATOR (op)
The "op" is the defined unary, defined binary,
or extended intrinsic operator being defined.
ASSIGNMENT (=)
A "spec" can only be included in the END INTERFACE
statement if one was provided in the INTERFACE
statement; both "spec"s must be identical.
body Is one or more function or subroutine subprograms.
A function must end with END FUNCTION and a subroutine
must end with END SUBROUTINE.
The subprogram must not contain a statement function
or a DATA, ENTRY or FORMAT statement; an entry name
can be used as a procedure name.
The subprogram can contain a USE statement.
nam Is the name of one or more module procedures that
are accessible in the host. The MODULE PROCEDURE
statement is only allowed if the interface block
specifies a "spec" and has a host that is a module
(or accesses a module by use association).
The characteristics of module procedures are not
given in interface blocks, but are assumed from
the module subprogram definitions.
Interface blocks can appear in the specification part of the
program unit that invokes the external or dummy procedure.
The characteristics specified for the external or dummy procedure
must be consistent with those specified in the procedure's
definition.
An interface block must not appear in a block data program unit.
An interface block comprises its own scoping unit, and does not
inherit anything from its host through host association.
A procedure must not have more than one explicit interface in a
given scoping unit.
For more information, see the HP Fortran for OpenVMS Language
Reference Manual.
EXAMPLES:
The following example shows a simple procedure interface block with
no generic specification:
SUBROUTINE SUB_B (B, FB)
REAL B
...
INTERFACE
FUNCTION FB (GN)
REAL FB, GN
END FUNCTION
END INTERFACE
1 – Generic Names
An interface block can be used to specify a generic name to
reference all of the procedures within the interface block.
Statement format for initial line in block:
INTERFACE generic-name
This kind of interface block can be used to extend or redefine a
generic intrinsic procedure.
The procedures that are given the generic name must be the same
kind of subprogram: all must be functions, or all must be
subroutines.
Any procedure reference involving a generic procedure name must be
resolvable to one specific procedure; it must be unambiguous.
EXAMPLES:
INTERFACE GROUP_SUBS
SUBROUTINE INTEGER_SUB (A, B)
INTEGER, INTENT(INOUT) :: A, B
END SUBROUTINE INTEGER_SUB
SUBROUTINE REAL_SUB (A, B)
REAL, INTENT(INOUT) :: A, B
END SUBROUTINE REAL_SUB
SUBROUTINE COMPLEX_SUB (A, B)
COMPLEX, INTENT(INOUT) :: A, B
END SUBROUTINE COMPLEX_SUB
END INTERFACE
The three subroutines can be referenced by their individual
specific names or by the group name GROUP_SUBS.
The following example shows a reference to INTEGER_SUB:
INTEGER V1, V2
CALL GROUP_SUBS (V1, V2)
2 – Generic Operators
An interface block can be used to define a generic operator. The
only procedures allowed in the interface block are functions that
can be referenced as defined operations. Statement format for
initial line in block:
INTERFACE OPERATOR (op)
op Is one of the following:
A defined unary operator (one argument)
A defined binary operator (two arguments)
An extended intrinsic operator (number of arguments
must be consistent with the intrinsic uses of
that operator)
The functions within the interface block must have one or two
nonoptional arguments with intent IN, and the function result must
not be of type character with assumed length. A defined operation
is treated as a reference to the function.
EXAMPLES:
INTERFACE OPERATOR(.BAR.)
FUNCTION BAR(A_1)
INTEGER, INTENT(IN) :: A_1
INTEGER :: BAR
END FUNCTION BAR
END INTERFACE
The following example shows a way to reference function BAR by
using the new operator:
INTEGER B
I = 4 + (.BAR. B)
The following is an example of a procedure interface block with a
defined operator extending an existing operator:
INTERFACE OPERATOR(+)
FUNCTION LGFUNC (A, B)
LOGICAL, INTENT(IN) :: A(:), B(SIZE(A))
LOGICAL :: LGFUNC(SIZE(A))
END FUNCTION LGFUNC
END INTERFACE
The following example shows two equivalent ways to reference
function LGFUNC:
LOGICAL, DIMENSION(1:10) :: C, D, E
N = 10
E = LGFUNC(C(1:N), D(1:N))
E = C(1:N) + D(1:N)
3 – Generic Assignment
An interface block can be used to define generic assignment. The
only procedures allowed in the interface block are subroutines that
can be referenced as defined assignments. Statement format for
initial line in block:
INTERFACE ASSIGNMENT(=)
The subroutines within the interface block must have two
nonoptional arguments, the first with intent OUT or INOUT, and the
second with intent IN.
A defined assignment is treated as a reference to a subroutine.
The left side of the assignment corresponds to the first dummy
argument of the subroutine; the right side of the assignment
corresponds to the second argument.
The ASSIGNMENT keyword extends or redefines an assignment operation
if both sides of the equal sign are of the same derived type.
Any procedure reference involving generic assignment must be
resolvable to one specific procedure; it must be unambiguous.
EXAMPLES:
INTERFACE ASSIGNMENT (=)
SUBROUTINE BIT_TO_NUMERIC (NUM, BIT)
INTEGER, INTENT(OUT) :: NUM
LOGICAL, INTENT(IN) :: BIT(:)
END SUBROUTINE BIT_TO_NUMERIC
SUBROUTINE CHAR_TO_STRING (STR, CHAR)
USE STRING_MODULE ! Contains definition
! of type STRING
TYPE(STRING), INTENT(OUT) :: STR ! A variable-length string
CHARACTER(*), INTENT(IN) :: CHAR
END SUBROUTINE CHAR_TO_STRING
END INTERFACE
The following example shows two equivalent ways to reference
subroutine BIT_TO_NUMERIC:
CALL BIT_TO_NUMERIC(X, (NUM(I:J)))
X = NUM(I:J)
The following example shows two equivalent ways to reference
subroutine CHAR_TO_STRING:
CALL CHAR_TO_STRING(CH, '432C')
CH = '432C'