This document describes those parts of the Fortran 2008 language which are not in Fortran 2003, and which are supported by the latest release of the NAG Fortran Compiler.
The compiler release in which a feature was made available is indicated by square brackets; for example, a feature marked as ‘[5.3]’ was first available in Release 5.3.
The new features of Fortran 2008 that are supported by the NAG Fortran Compiler can be grouped as follows:
Release 6.2 of the NAG Fortran Compiler limited execution to a single image, with no parallel execution. Release 7.0 of the NAG Fortran Compiler can execute multiple images in parallel on SMP machines, using Co-SMP technology.
A coarray has a “corank”, which is the number of “codimensions” it has. Each codimension has a lower “cobound” and an upper cobound, determining the “coshape”. The upper cobound of the last codimension is “*”; rather like an assumed-size array. The “cosubscripts” determine the image index of the reference, in the same way that the subscripts of an array determine the array element number. Again, like an assumed-size array, the image index must be less than or equal to the number of images.
A coarray can be a scalar or an array. It cannot have the POINTER attribute, but it can have pointer components.
As well as variables, coarray components are possible. In this case, the component must be an ALLOCATABLE coarray, and any variable with such a component must be a dummy argument or have the SAVE attribute.
REAL a[100,*]
REAL,CODIMENSION[-10:10,-10:*] :: b
CODIMENSION c[*]
declares the coarray A to have corank 2 with lower “cobounds”
both 1 and the first upper cobound 100, the coarray B to have corank 2 with lower
cobounds both −10 and the first upper cobound 10, and the coarray C to have corank
1 and lower cobound 1.
Note that for non-allocatable coarrays, the coarray-spec must always declare the
last upper cobound with an asterisk, as this will vary depending on the number of images.
An ALLOCATABLE coarray is declared with a deferred-coshape-spec, for example,
REAL,ALLOCATABLE :: d[:,:,:,:]
declares the coarray D to have corank 4.
REAL,SAVE :: e[*]
the coindexed object e[1] refers to the copy of E on image 1, and e[13] refers to the copy of E on image 13.
For a more complicated example: given
REAL,SAVE :: f[10,21:30,0:*]
the reference f[3,22,1] refers to the copy of F on image 113.
There is no correlation between image numbers and any topology of the computer, so it is
probably best to avoid complicated codimensions, especially if different coarrays have different
coshape.
When a coarray is an array, you cannot put the cosubscripts directly after the array name, but must use array section notation instead. For example, with
REAL,SAVE :: g(10,10)[*]
the reference g[inum] is invalid, to refer to the whole array G on image INUM you
need to use g(:,:)[inum] instead.
Similarly, to access a single element of G, the cosubscripts follow the subscripts, e.g. g(i,j)[inum].
Finally, note that when a coarray is accessed, whether by its own image or remotely, the segment ordering rules (see next section) must be obeyed. This is to avoid nonsense answers from data races.
If a coarray is defined (assigned a value) in a segment on image I, another image J is only allowed to reference or define it in a segment that follows the segment on I.
The image control statements, and their synchronisation effects, are as follows.
Note that image control statements have side-effects, and therefore are not permitted in pure procedures or within DO CONCURRENT constructs.
REAL,ALLOCATABLE :: x(:,:,:)[:,:]
...
ALLOCATE(x(100,100,3)[1:10,*])
Note that the last upper cobound must be an asterisk, the same as when declaring an
explicit-coshape coarray.
When allocating a coarray there is a synchronisation: all images must execute the same ALLOCATE statement, and all the bounds, type parameters, and cobounds of the coarray must be the same on all images.
Similarly, there is a synchronisation when a coarray is deallocated, whether by a DEALLOCATE statement or automatic deallocation by an END statement; every image must execute the same statement.
Note that the usual automatic reallocation of allocatable variables in an intrinsic assignment statement, e.g. when the expression is an array of a different shape, is not available for coarrays. An allocatable coarray variable being assigned to must already be allocated and be conformable with the expression; furthermore, if it has deferred type parameters they must have the same values, and if it is polymorphic it must have the same dynamic type.
CRITICAL
...do something
END CRITICAL
If an image I arrives at the CRITICAL statement while another image J is executing
the block of the construct, it will wait until image J has executed the END CRITICAL
statement before continuing.
Thus the CRITICAL — END CRITICAL segment on image I follows the equivalent
segment on image J.
As a construct, this may have a name, e.g.
critsec: CRITICAL
...
END CRITICAL critsec
The name has no effect on the operation of the construct.
Each CRITICAL construct is separate from all others, and has no effect on their execution.
Execution of the segment after a LOCK statement successfully locks the variable follows execution of the segment before the UNLOCK statement on the image that unlocked it. For example,
INTEGER FUNCTION get_sequence_number()
USE iso_fortran_env
INTEGER :: number = 0
TYPE(lock_type) lock[*]
LOCK(lock[1])
number = number + 1
get_sequence_number = number
UNLOCK(lock[1])
END FUNCTION
If the variable lock on image 1 is locked when the LOCK statement is executed,
it will wait for it to become unlocked before continuing.
Thus the function get_sequence_number() provides an one-sided ordering relation: the segment
following a call that returned the value N will follow every segment that preceded a call
that returned a value less than N.
Conditional locking is provided with the ACQUIRED_LOCK= specifier; if this specifier is present, the executing image only acquires the lock if it was previously unlocked. For example,
LOGICAL gotit
LOCK(lock[1],ACQUIRED_LOCK=gotit)
IF (gotit) THEN
! We have the lock.
ELSE
! We do not have the lock - some other image does.
END IF
It is an error for an image to try to LOCK a variable that is already locked to that image, or to UNLOCK a variable that is already unlocked, or that is locked to another image. If the STAT= specifier is used, these errors will return the values STAT_LOCKED, STAT_UNLOCKED, or STAT_LOCKED_OTHER_IMAGE respectively (these named constants are provided by the intrinsic module ISO_FORTRAN_ENV).
MODULE stopping
USE iso_fortran_env
LOGICAL(atomic_logical_kind),PRIVATE :: stop_flag[*] = .FALSE.
CONTAINS
SUBROUTINE make_it_stop
CALL atomic_define(stop_flag[1],.TRUE._atomic_logical_kind)
END SUBROUTINE
LOGICAL FUNCTION please_stop()
CALL atomic_ref(please_stop,stop_flag[1])
END FUNCTION
END MODULE
In this example, it is perfectly valid for any image to call make_it_stop, and for any
other image to invoke the function please_stop(), without any regard for segments.
(On a distributed memory machine it might take some time for changes to the atomic variable
to be visible on other images, but they should eventually get the message.)
Note that ordinary assignment and referencing should not be mixed with calls to the atomic subroutines, as ordinary assignment and referencing are always subject to the segment ordering rules.
When normal termination has been initiated on all images, the program terminates.
The ERROR STOP statement initiates error termination.
The FAIL IMAGE statement itself is not very useful when the number of images is equal to one, as it inevitably causes complete program failure.
In a data object designator, a part (component or base object) that is a coarray can include an image selector: part-name [ ( section-subscript-list ) ] [ image-selector ]
where part-name identifies a coarray, and image-selector isleft-bracket cosubscript-list [ , image-selector-spec ] right-bracket
The number of cosubscripts must be equal to the corank of part-name. If image-selector appears and part-name is an array, section-subscript-list must also appear. The optional image-selector-spec is Fortran 2018 (part of the fault tolerance feature), and is a comma-separated list of one or more of the following specifiers:
STAT = scalar-int-variable
TEAM = team-value
TEAM_NUMBER = scalar-int-expression
CRITICAL construct:
[ construct-name : ] CRITICAL [ ( [ sync-stat-list ] ) ]
block
END CRITICAL [ construct-name ]
The block is not permitted to contain:
FAIL IMAGE statement:
FAIL IMAGE
Note: This statement is Fortran 2018.LOCK statement:
LOCK ( lock-variable [ , lock-stat-list ] )
where lock-stat-list is a comma-separated list of one or more of the following:
ACQUIRED_LOCK = scalar-logical-variable
ERRMSG = scalar-default-character-variable
STAT = scalar-int-variable
SYNC ALL statement:
SYNC ALL [ ( [ sync-stat-list ] ) ]
SYNC IMAGES statement:
SYNC IMAGES ( image-set [ , sync-stat-list ] )
where image-set is an asterisk, or an integer expression that is scalar or of rank one.SYNC MEMORY statement:
SYNC MEMORY [ ( [ sync-stat-list ] ) ]
UNLOCK statement:
UNLOCK ( lock-variable [ , sync-stat-list ] )
Note:
SUBROUTINE ATOMIC_DEFINE(ATOM, VALUE, STAT)
SUBROUTINE ATOMIC_REF(VALUE, ATOM, STAT)
INTEGER FUNCTION IMAGE_INDEX(COARRAY, SUB)
FUNCTION LCOBOUND(COARRAY, DIM , KIND)
SUBROUTINE MOVE_ALLOC(FROM, TO, STAT, ERRMSG) ! Revised
INTEGER FUNCTION NUM_IMAGES()
This intrinsic function returns the number of images.
In this release of the NAG Fortran Compiler, the value will always be equal to one.
INTEGER FUNCTION THIS_IMAGE()
Returns the image index of the executing image.
FUNCTION THIS_IMAGE(COARRAY)
Returns an array of type Integer with default kind, with the size equal to the corank of
COARRAY, which may be a coarray of any type.
The values returned are the cosubscripts for COARRAY that correspond to the executing
image.
INTEGER FUNCTION THIS_IMAGE(COARRAY, DIM)
FUNCTION UCOBOUND(COARRAY, DIM, KIND)
If DIM appears, the result is scalar, being the value of the upper cobound of that codimension of COARRAY. If DIM does not appear, the result is a vector of length N containing all the upper cobounds of COARRAY. The actual argument for DIM must not itself be an optional dummy argument.
Note that if COARRAY has corank N>1, and the number of images in the current execution is not an integer multiple of the coextents up to codimension N−1, the images do not make a full rectangular pattern. In this case, the value of the last upper cobound is the maximum value that a cosubscript can take for that codimension; e.g. with a coarray-spec of [1:3,1:*] and four images in the execution, the last upper cobound will be equal to 2 because the cosubscripts [1,2] are valid even though [2,2] and [2,3] are not.
REAL array(2,2,2,2,2,2,2,2,2,2,2,2,2,2,2)declares a 15-dimensional array.
REAL,PARAMETER :: idmat3(*,*) = Reshape( [ 1,0,0,0,1,0,0,0,1 ], [ 3,3 ] ) REAL,PARAMETER :: yeardata(2000:*) = [ 1,2,3,4,5,6,7,8,9 ]declares idmat3 to have the bounds (1:3,1:3), and yeardata to have the bounds (2000:2008).
TYPE(REAL) x TYPE(COMPLEX(KIND(0d0))) y TYPE(CHARACTER(LEN=80)) zis completely equivalent, apart from being more confusing, to
REAL x COMPLEX(KIND(0d0)) y CHARACTER(LEN=80) z
PROCEDURE,NOPASS :: a
PROCEDURE,NOPASS :: b=>x
PROCEDURE,NOPASS :: c
the single statement
PROCEDURE,NOPASS :: a, b=>x, c
will suffice.
INTEGER workspace(MERGE(10,20,C_ASSOCIATED(X,C_LOC(Y))))
is allowed, and will give workspace a size of 10 elements if the C pointer X is associated with Y, and 20 elements otherwise.
INTERFACE OPERATOR(.user.)
PURE INTEGER FUNCTION userfun(x)
REAL,INTENT(IN) :: x
END FUNCTION
END INTERFACE
the user-defined operator .user. may be used in a specification expression as follows:
LOGICAL mask(.user.(3.145))
Note that this applies to overloaded intrinsic operators as well as user-defined operators.
For example,
SUBROUTINE s(x,mask)
REAL x(:,:,:)
LOGICAL mask(:,:,:)
REAL,ALLOCATABLE :: y(:,:,:)
ALLOCATE(y,MOLD=x)
WHERE (mask)
y = 1/x
ELSEWHERE
y = HUGE(x)
END WHERE
! ...
END SUBROUTINE
PROGRAM multi_alloc
INTEGER,ALLOCATABLE :: x(:),y(:,:)
ALLOCATE(x(3),y(2,4),SOURCE=42)
PRINT *,x,y
END PROGRAM
will print the value “42” eleven times (the three elements of x
and the eight elements of y).
If the source-expr is an array, every allocation needs to have the
same shape.
COMPLEX,PARAMETER :: c = (1,2), ca(2) = [ (3,4),(5,6) ]the designators c%re and c%im have the values 1 and 2 respectively, and ca%re and ca%im are arrays with the values [ 3,5 ] and [ 4,6 ] respectively. In the case of variables, for example
COMPLEX :: v, va(10)the real and imaginary parts can also be assigned to directly; the statement
va%im = 0will set the imaginary part of each element of va to zero without affecting the real part.
CLASS(*),POINTER :: a,b,c ALLOCATE(a,b,c,MOLD=125)will allocate the unlimited polymorphic pointers A, B and C to be of type Integer (with default kind); unlike SOURCE=, the values of A, B and C will be undefined.
CLASS(*),ALLOCATABLE :: xexecution of the assignment statement
x = 43will result in X having dynamic type Integer (with default kind) and value 43, regardless of whether X was previously unallocated or allocated with any other type (or kind).
REAL,TARGET :: x(100,100) REAL,POINTER :: x1(:) x1(1:Size(x)) => xestablishes X1 as a single-dimensional alias for the whole of X.
Do i=1,n
Block
Real tmp
tmp = a(i)**3
If (tmp>b(i)) b(i) = tmp
End Block
End Do
Here the variable tmp has its scope limited to the BLOCK
construct, so will not affect anything outside it.
This is particularly useful when including code by INCLUDE or by
macro preprocessing.
All declarations are allowed within a BLOCK construct except for COMMON, EQUIVALENCE, IMPLICIT, INTENT, NAMELIST, OPTIONAL and VALUE; also, statement function definitions are not permitted.
BLOCK constructs may be nested; like other constructs, branches into a BLOCK construct from outside are not permitted. A branch out of a BLOCK construct “completes” execution of the construct.
Entities within a BLOCK construct that do not have the SAVE attribute (including implicitly via initialisation), will cease to exist when execution of the construct is completed. For example, an allocated ALLOCATABLE variable will be automatically deallocated, and a variable with a FINAL procedure will be finalised.
For example,
IF (x<=0) ERROR STOP 'x must be positive'
Complex i(100) Real x(200) ... Forall (Integer :: i=1:Size(x)) x(i) = i
Note that the FORALL construct is still not recommended for high performance, as the semantics imply evaluating the right-hand sides into array temps the size of the iteration space, and then assigning to the variables; this usually performs worse than ordinary DO loops.
The DO CONCURRENT header has similar syntax to the FORALL header, including the ability to explicitly specify the type and kind of the loop index variables, and including the scalar mask.
The restrictions on the DO CONCURRENT construct are:
For example,
Integer vsub(n)
...
Do Concurrent (i=1:n)
! Safe because vsub has no duplicate values.
x(vsub(i)) = i
End Do
The full syntax of the DO CONCURRENT statement is:
[ do-construct-name : ] DO [ label ] [ , ] CONCURRENT forall-header
where forall-header is( [ integer-type-spec :: ] triplet-spec [ , triplet-spec ]... [ , mask-expr ] )
where mask-expr is a scalar logical expression, and triplet-spec isname = expr : expr [ : expr ]
For example, ACOSH(1.543081), ASINH(1.175201) and ATANH(0.7615942) are all approximately equal to 1.0.
The elemental form has two arguments: N, the order of the function to compute, and X, the argument of the Bessel function. BESSEL_JN(0,X) is identical to BESSEL_J0(X), etc..
The transformational form has three scalar arguments: N1, N2 and X. The result is a vector of size MAX(N2-N1+1,0), containing approximations to the Bessel functions of orders N1 to N2 applied to X.
For example, BESSEL_JN(5,7.5) is approximately 0.283474, BESSEL_YN(5,7.5) is approximately 0.175418, BESSEL_JN(3,5,7.5) is approximately [ -0.258061, 0.023825, 0.283474 ] and BESSEL_YN(3,5,7.5) is approximately [ 0.159708, 0.314180, 0.175418 ].
The error function is the integral of −t2 from 0 to X, times 2/SQRT(π); this rapidly converges to 1. The complementary error function is 1 minus the error function, and fairly quickly converges to zero. The scaled complementary error function scales the value (of 1 minus the error function) by EXP(X**2); this also converges to zero but only very slowly.
The gamma function is the extension of factorial from the integers to the reals; for positive integers, GAMMA(X) is equal to (X−1)!, i.e. factorial of X−1. This grows very rapidly and thus overflows for quite small X; LOG_GAMMA also diverges but much more slowly.
For example, HYPOT(3e30,4e30) is approximately equal to 5e30.
The calculation of the result value is done in such a way as to avoid intermediate overflow and underflow, except when the result itself is outside the maximum range. For example, NORM2([X,Y]) is approximately the same as HYPOT(X,Y).
For example, BGE(INT(Z'FF',INT8),128) is true, while INT(Z'FF',INT8)>=128 is false.
For example, DSHIFTL(INT(B'11000101',1),B'11001001',2) has the value INT(B'00010111',1) (decimal value 23), whereas DSHIFTR(INT(B'11000101',1),B'11001001',2) has the value INT(B'01110010',1) (decimal value 114).
Note that MERGE_BITS(I,J,MASK) is identical to IOR(IAND(I,MASK),IAND(J,NOT(MASK))).
For example, MERGE_BITS(INT(B'00110011',1),B'11110000',B'10101010') is equal to INT(B'01110010') (decimal value 114).
CMDSTAT values are zero for success, −1 if command line execution is not supported, −2 if WAIT is present and false but asynchronous execution is not supported, and a positive value to indicate some other error. If CMDSTAT is not present but would have been set non-zero, the program will be terminated. Note that Release 5.3.1 supports command line execution on all systems, and does not support asynchronous execution on any system.
For example, CALL EXECUTE_COMMAND_LINE('echo Hello') will probably display ‘Hello’ in the console window.
If A is allocatable or a pointer, it does not have to be allocated unless it has a deferred type parameter (e.g. CHARACTER(:)) or is CLASS(*). If it is a polymorphic pointer, it must not have an undefined status.
For example, STORAGE_SIZE(13_1) is equal to 8 (bits).
FINDLOC (ARRAY, VALUE, DIM, MASK, KIND, BACK )
FINDLOC (ARRAY, VALUE, MASK, KIND, BACK )
where
| ARRAY | is an array of intrinsic type, with rank N; |
| VALUE | is a scalar of the same type (if LOGICAL) or which may be compared with ARRAY using the intrinsic |
| operator == (or .EQ.); | |
| DIM | is a scalar INTEGER in the range 1 to N; |
| MASK | (optional) is an array of type LOGICAL with the same shape as ARRAY |
| KIND | (optional) is a scalar INTEGER constant expression that is a valid Integer kind number; |
| BACK | (optional) is a scalar LOGICAL value. |
The result of the function is type INTEGER, or INTEGER(KIND) if KIND is present.
In the form without DIM, the result is a vector of length N, and is the location of the element of ARRAY that is equal to VALUE; if MASK is present, only elements for which the corresponding element of MASK are .TRUE. are considered. As in MAXLOC and MINLOC, the location is reported with 1 for the first element in each dimension; if no element equal to VALUE is found, the result is zero. If BACK is present with the value .TRUE., the element found is the last one (in array element order); otherwise, it is the first one.
In the form with DIM, the result has rank N−1 (thus scalar if ARRAY is a vector), the shape being that of ARRAY with dimension DIM removed, and each element of the result is the location of the (masked) element in the dimension DIM vector that is equal to VALUE.
For example, if ARRAY is an Integer vector with value [ 10,20,30,40,50 ], FINDLOC(ARRAY,30) will return the vector [ 3 ] and FINDLOC(ARRAY,7) will return the vector [ 0 ].
For example, the value of
MAXLOC( [ 5,1,5 ], BACK=.TRUE.)
is the array [ 3 ], rather than [ 1 ].
INTERFACE c_sizeof
PURE INTEGER(c_size_t) FUNCTION c_sizeof...(x) ! Specific name not visible
TYPE(*) :: x(..)
END FUNCTION
END INTERFACE
The actual argument x must be interoperable. The result is the same as the C sizeof operator applied to the conceptually corresponding C entity; that is, the size of x in bytes. If x is an array, it is the size of the whole array, not just one element. Note that x cannot be an assumed-size array.
[6.1] The standard intrinsic module ISO_FORTRAN_ENV contains two new functions as follows.
Module version_info
Use Iso_Fortran_Env
Character(Len(Compiler_Version())) :: compiler = Compiler_Version()
End Module
Program show_version_info
Use version_info
Print *,compiler
End Program
With release 6.1 of the NAG Fortran Compiler, this program will print something
like
NAG Fortran Compiler Release 6.1(Tozai) Build 6105
Module options_info
Use Iso_Fortran_Env
Character(Len(Compiler_Options())) :: compiler = Compiler_Options()
End Module
Program show_options_info
Use options_info
Print *,compiler
End Program
If compiled with the options -C=array
-C=pointer -O, this program will print
something like
-C=array -C=pointer -O
INTEGER unit
OPEN(FILE='output.log',FORM='FORMATTED',NEWUNIT=unit)
WRITE(unit,*) 'Logfile opened.'
The NEWUNIT= specifier can only be used if either the FILE=
specifier is also used, or if the STATUS= specifier is used with the
value 'SCRATCH'.
Write (*,Output_Unit) f(100)the function f is permitted to perform i/o on any unit except Output_Unit; for example, if the value 100 is out of range, it would be allowed to produce an error message with
Write (*,Error_Unit) 'Error in F:',n,'is out of range'
SUBROUTINE s(x)
LOGICAL x(:)
PRINT 1,x
1 FORMAT('x =',*(:,' ',L1))
END SUBROUTINE
will display the entire array x on a single line, no matter how many
elements x has.
An indefinite repeat count is only allowed at the top level of the format
specification, and must be the last format item.
PRINT 1,1.25,.True.,"Hi !",123456789 1 FORMAT(*(G0,','))produces the output
1.250000,T,Hi !,123456789,
For example,
SUBROUTINE mysub(coeffs)
REAL,INTENT(IN) :: coeffs(0:) ! Coefficients of polynomial.
REAL integral
integral = integrate(myfunc,0.0,1.0) ! Integrate from 0.0 to 1.0.
PRINT *,'Integral =',integral
CONTAINS
REAL FUNCTION myfunc(x) RESULT(y)
REAL,INTENT(IN) :: x
INTEGER i
y = coeffs(UBOUND(coeffs,1))
DO i=UBOUND(coeffs,1)-1,0,-1
y = y*x + coeffs(i)
END DO
END FUNCTION
END SUBROUTINE
Impure Elemental Integer Function checked_addition(a,b) Result(c)
Integer,Intent(In) :: a,b
If (a>0 .And. b>0) Then
If (b>Huge(c)-a) Stop 'Positive Integer Overflow'
Else If (a<0 .And. b<0) Then
If ((a+Huge(c))+b<0) Stop 'Negative Integer Overflow'
End If
c = a + b
End Function
When an argument is an array, an impure elemental procedure is applied to each
element in array element order (unlike a pure elemental procedure, which has no
specified order).
An impure elemental procedure cannot be referenced in a context that requires a
procedure to be pure, e.g. within a FORALL construct.
Impure elemental procedures are probably most useful for debugging (because i/o is allowed) and as final procedures.
PURE SUBROUTINE s(a,b)
REAL,INTENT(OUT) :: a
REAL,VALUE :: b
a = b
END SUBROUTINE
Note however that the second argument of a defined assignment subroutine, and all arguments of a defined operator function, are still required to have the INTENT(IN) attribute even if they have the VALUE attribute.
SUBROUTINE sub() BIND(C,NAME='one')
PRINT *,'one'
END SUBROUTINE
SUBROUTINE sub() BIND(C,NAME='two')
PRINT *,'two'
END SUBROUTINE
PROGRAM test
INTERFACE
SUBROUTINE one() BIND(C)
END SUBROUTINE
SUBROUTINE two() BIND(C)
END SUBROUTINE
END INTERFACE
CALL one
CALL two
END PROGRAM
The effect is that a copy is made of the actual argument, and the dummy argument is associated with the copy; any changes to the dummy argument do not affect the actual argument. For example,
PROGRAM value_example_2008
INTEGER :: a(3) = [ 1,2,3 ]
CALL s('Hello?',a)
PRINT '(7X,3I6)',a
CONTAINS
SUBROUTINE s(string,j)
CHARACTER(*),VALUE :: string
INTEGER,VALUE :: j(:)
string(LEN(string):) = '!'
j = j + 1
PRINT '(7X,A,3I6)',string,j
END SUBROUTINE
END PROGRAM
will produce the output
Hello! 2 3 4
1 2 3
A “separate module procedure” is a procedure whose interface is declared in the module specification part, but whose definition may provided either in the module itself, or in a submodule of that module. The interface of a separate module procedure is declared by using the MODULE keyword in the prefix of the interface body. For example,
INTERFACE
MODULE RECURSIVE SUBROUTINE sub(x,y)
REAL,INTENT(INOUT) :: x,y
END SUBROUTINE
END INTERFACE
An important aspect of the interface for a separate module procedure is that, unlike any other
interface body, it accesses the module by host association without the need for an IMPORT
statement.
For example,
INTEGER,PARAMETER :: wp = SELECTED_REAL_KIND(15)
INTERFACE
MODULE REAL(wp) FUNCTION f(a,b)
REAL(wp) a,b
END FUNCTION
END INTERFACE
The eventual definition of the separate module procedure, whether in the module itself or in a submodule,
must have exactly the same characteristics, the same names for the dummy arguments, the same name for the result variable (if a function), the same binding-name (if it uses BIND(C)), and be
RECURSIVE if and only if the interface is declared so.
There are two ways to achieve this:
...
CONTAINS
MODULE REAL(wp) FUNCTION f(a,b)
REAL(wp)a,b
f = a**2 - b**3
END FUNCTION
...
CONTAINS
MODULE PROCEDURE sub
! Arguments A and B, their characteristics, and that this is a recursive subroutine,
! are all taken from the interface declaration.
IF (a>b) THEN
CALL sub(b,-ABS(a))
ELSE
a = b**2 - a
END IF
END PROCEDURE
submodule-stmt
declaration-part
[ CONTAINS
module-subprogram-part ]
END [ SUBMODULE [ submodule-name ] ]
The initial submodule-stmt has the form
SUBMODULE ( module-name [ : parent-submodule-name ] ) submodule-name
where module-name is the name of a module with one or more separate module procedures,
parent-submodule-name (if present) is the name of another submodule of that module,
and submodule-name is the name of the submodule being defined.
The submodules of a module thus form a tree structure, with successive submodules being able
to extend others; however, the name of a submodule is unique within that module.
This structure is to facilitate creation of internal infrastructure (types, constants, and
procedures) that can be used by multiple submodules,
without having to put all the infrastructure inside the module itself.
The submodule being defined accesses its parent module or submodule by host association; for entities from the module, this includes access to PRIVATE entities. Any local entity it declares in the declaration-part will therefore block access to an entity in the host that has the same name.
The entities (variables, types, procedures) declared by the submodule are local to that submodule, with the sole exception of separate module procedures that are declared in the ancestor module and defined in the submodule. No procedure is allowed to have a binding name, again, except in the case of a separate module procedure, where the binding name must be the same as in the interface.
For example,
MODULE mymod
INTERFACE
MODULE INTEGER FUNCTION next_number() RESULT(r)
END FUNCTION
MODULE SUBROUTINE reset()
END SUBROUTINE
END INTERFACE
END MODULE
SUBMODULE (mymod) variables
INTEGER :: next = 1
END SUBMODULE
SUBMODULE (mymod:variables) functions
CONTAINS
MODULE PROCEDURE next_number
r = next
next = next + 1
END PROCEDURE
END SUBMODULE
SUBMODULE (mymod:variables) subroutines
CONTAINS
MODULE SUBROUTINE reset()
PRINT *,'Resetting'
next = 1
END SUBROUTINE
END SUBMODULE
PROGRAM demo
USE mymod
PRINT *,'Hello',next_number()
PRINT *,'Hello again',next_number()
CALL reset
PRINT *,'Hello last',next_number()
END PROGRAM
Submodule information for use by other submodules is stored by the NAG Fortran Compiler in files named module.submodule.sub, in a format similar to that of .mod files. The -nomod option, which suppresses creation of .mod files, also suppresses creation of .sub files.
The Fortran 2008 standard, IS 1539-1:2010(E), is available from ISO as well as from many national standards bodies. A number of books describing the new standard are available; the recommended reference book is “Modern Fortran Explained” by Metcalf, Reid & Cohen, Oxford University Press, 2011 (ISBN 978-0-19-960141-7).