This section contains a quick reference guide to the statements in Fortran 95.
type-spec ::= | numeric-type [ kind-specifier ] | |
numeric-type * digit-string | | |
DOUBLE PRECISION | | |
CHARACTER [ char-specifier ] |
numeric-type ::= COMPLEX | INTEGER | LOGICAL | REAL |
kind-specifier ::= ( [ KIND = ] expr ) |
char-specifier ::= | * digit-string | |
* ( char-length ) | | |
( char-length [ , [ KIND = ] expr ] ) | | |
( LEN = char-length [ , KIND = expr ] ) | | |
( KIND = expr [ , LEN = char-length ] ) |
char-length ::= *
| expr
label ::= digit-string |
Note that the digit-string in a label must contain at most 5 digits, and at least one of them must be non-zero. Leading zeroes are not significant, but do count towards the limit of 5.
Although it is not shown in the syntax definitions, all statements may be
labelled and the FORMAT
statement must be labelled.
construct-name ::= name |
Construct names are “class 1” names, and must not be the same as any other class 1 name in a subprogram; class 1 names includes variables, procedures, program unit names, et cetera.
entity-decl-list ::= entity-decl [ , entity-decl ] ... |
entity-decl ::= name [ * char-length ] [ array-spec ] [ initial-value ] |
array-spec ::= explicit-shape | assumed-shape | deferred-shape | assumed-size |
explicit-shape ::= ( explicit-bound [ , explicit-bound ] ... ) |
explicit-bound ::= [ expr : ] expr |
assumed-shape ::= ( assumed-bound [ , assumed-bound ] ... ) |
assumed-bound ::= [ expr ] : |
deferred-shape ::= ( deferred-bound [ , deferred-bound ] ... ) |
deferred-bound ::= : |
assumed-size ::= ( [ explicit-bound , ]... assumed-size-bound ) |
assumed-size-bound ::= [ expr : ] * |
initial-value ::= = expression | => NULL() |
ALLOCATABLE [ :: ] name [ deferred-shape ] [ , name [ deferred-shape ] ] ... |
Declares the listed entities to be allocatable arrays. If array bounds are present, they must be deferred.
ALLOCATE ( allocate-item [ , allocate-item ] ... [ , STAT = variable ] ) |
allocate-item ::= variable [ explicit-shape ] |
Allocates a pointer or allocatable array.
If the allocation fails and the STAT=
clause is present, the
STAT=
variable will be assigned a non-zero value.
IF ( expr ) label , label , label |
Branches to one of three labels depending on whether expr is negative, zero or positive respectively. The expression must be scalar and of type integer or real.
variable = expr |
The expression is evaluated and assigned to the variable. For intrinsic assignment, it must be assignment-compatible with the variable, that is:
LOGICAL
, the expression must be LOGICAL
but may be any KIND
.
CHARACTER
, the expression must be of
type CHARACTER
and of the same KIND
.
INTEGER
, REAL
or COMPLEX
, the
expression must be of type INTEGER
, REAL
or COMPLEX
.
ASSIGNMENT(=)
which matches the types, kinds and ranks of the variable
and expression; the user-specified assignment routine is called.
Note that in the case of derived types, defined assignment is permitted to
override the intrinsic assignment.
BACKSPACE expr |
BACKSPACE ( position-spec-list ) |
position-spec-list ::= position-spec [ , position-spec ] |
position-spec ::= { [ UNIT= ] expr } | { IOSTAT= variable } | { ERR= label } |
Note: A position-spec-list is required to have a UNIT=
position-spec; the UNIT=
keyword and equals sign may be omitted
only if it is the first in the list.
Positions the file connected to the specified unit to the record preceding the current one. An error condition is raised if the file is not connected, or the unit does not support backspacing.
The effect of each position-spec is as below:
UNIT=
ERR=
IOSTAT=
BLOCK DATA [ name ] |
This is the first statement of a block data subprogram. All but one block data subprogram must be named.
CALL name [ ( [ actual-arg-list ] ) ] |
actual-arg-list ::= actual-arg [ , actual-arg ]... |
actual-arg ::= expr | * label |
Calls the named subroutine.
CASE DEFAULT [ construct-name ] |
CASE ( case-value-range [ , case-value-range ]... ) [ construct-name ] |
case-value-range ::= | expr [ : [ expr ] ] | |
: expr |
Marks the beginning of a CASE
part (and the end of any preceding
CASE
part).
Statements in this part are executed if the corresponding SELECT
expression value satisfies the appropriate CASE
condition:
.EQ.
(
expr)
.
.LE.
(:
expr)
.
.GE.
(
expr:)
.
(
expr:
expr)
is satisfied for values greater than or equal to the first expression, and less
than or equal to the second expression.
DEFAULT
CASE DEFAULT
clause is selected if the value does not satisfy any
other CASE
statements in that SELECT
construct.
Note that within a SELECT
construct, each CASE
statement must
have distinct conditions so that only one can be satisfied.
CLOSE expr |
CLOSE ( position-spec-list ) |
(See the BACKSPACE
statement for the position-spec-list
definition.)
Closes the specified unit.
COMMON | [ / [ common-block-name ] / ] common-object-list |
[ [ , ] / [ common-block-name ] / common-object-list ]... |
common-object-list ::= common-object [ , common-object ]... |
common-object ::= name [ array-spec ] |
Declares a common block.
If no common-block-name is specified, “blank common” is the common
block declared.
Multiple COMMON
statements for the same common block act as if the
common-object-lists were concatenated in a single statement.
type-spec [ [ , component-attribute-list ] :: ] entity-decl-list |
component-attribute-list ::= component-attr [ , component-attr ]... |
component-attr ::= | DIMENSION array-spec | |
POINTER |
Declares one or more components of a derived type.
Any array-spec in a component definition must be deferred-shape
if the POINTER
attribute is present, and must be explicit-shape
otherwise.
Any initial-value that is present defines the default value for that
component of any new entities of the type.
GOTO ( label [ , label ] ... ) expr |
The (integer scalar) expression is evaluated; if it is less than one or greater than the number of labels in the list, control is transferred to the next statement. Otherwise control is transferred to the corresponding label.
CONTAINS |
This statement separates the declarations of a module from its contained procedures, and the declarations and executables of a main program or procedure from its contained procedure.
CONTINUE |
This is an executable statement that has no effect.
If it has a label it may be used as the terminating statement of a DO
construct or as the target of a GOTO
, computed-GOTO
or
assigned-GOTO
.
CYCLE [ construct-name ] |
Begins the next iteration of either the specified DO
construct, or
if construct-name is omitted, the innermost enclosing DO
construct.
DATA data-set [ , data-set ]... |
data-set ::= data-object-list / data-value-list / |
data-object-list ::= data-object [ , data-object ]... |
data-object ::= variable | data-implied-do |
data-implied-do ::= ( data-object [ , data-object ]... do-spec ) |
data-value-list ::= data-value [ , data-value ]... |
data-value ::= [ data-repeat * ] data-constant |
data-repeat ::= constant | constant-subobject |
data-constant ::= | literal-constant | NULL() | structure-constructor | object | |
{ + | - } { real-literal | integer-literal } |
Declares the initial value of the specified objects.
This implicitly declares those objects to have the SAVE
attribute.
DEALLOCATE ( expr [ , expr ] [ , STAT = variable ] ) |
Deallocates the storage occupied by an allocatable array or pointer.
An error is raised if an allocatable array to be deallocated is not allocated,
or if a pointer to be deallocated is dissociated or is associated with an
object that was not allocated with ALLOCATE
.
DIMENSION [ :: ] name array-spec [ , name array-spec ]... |
Declares the name(s) to be arrays with the specified bounds.
[ construct-name : ] DO [ label ] [ , ] [ loop-control ] |
loop-control ::= | do-spec | |
WHILE ( logical-expr ) |
do-spec ::= name = expr , expr [ , expr ] |
The initial statement of a DO
loop.
If label is present, the loop ends on the statement with that label,
which cannot be a GOTO
, RETURN
, STOP
, EXIT
,
CYCLE
, END
or arithmetic IF
statement.
Nested DO
loops can share the same ending statement, provided it is
not an ENDDO
statement.
If the loop-control is missing, the DO
loop terminates only if
control is explicitly transferred outside the loop (e.g., by an EXIT
,
GOTO
or RETURN
statement).
If construct-name is present, the DO
loop must end with an
ENDDO
statement identified with the same construct-name.
ELSE [ construct-name ] |
Begins the ELSE
part of an IF-THEN
construct.
Statements in this part are executed only if the IF
condition is false
and all ELSEIF
conditions at the same level are false.
If the IF-THEN
statement had a construct-name, the ELSE
statement
may specify the same construct-name.
ELSE IF ( expr ) THEN [ construct-name ] |
Begins a (new) ELSEIF
part of an IF-THEN
construct.
Statements in this part are executed only if the IF
condition is false,
all preceding ELSEIF
conditions at the same level are false, and this
ELSEIF
condition is true.
If the IF-THEN
statement had a construct-name, the ELSEIF
statement may specify the same construct-name.
ELSEWHERE [ construct-name ] |
Begins the ELSEWHERE
part of a WHERE
construct.
The statements in this part are executed only for those elements for which
the WHERE
mask are false, and all ELSEWHERE
masks at the same
level are also false.
If the WHERE
statement had a construct-name, the ELSEWHERE
statement may specify the same construct-name.
ELSEWHERE ( expr ) [ construct-name ] |
Begins a masked ELSEWHERE
part of a WHERE
construct.
The statements in this part are executed only for those elements for which
the previous masks are false and this ELSEWHERE
mask are true.
(The previous masks are the WHERE
mask and all preceding ELSEWHERE
masks at the same level in this WHERE
construct.)
Note that the elements of the ELSEWHERE
mask that do not correspond to
false elements of the previous masks are not evaluated.
If the WHERE
statement had a construct-name, the ELSEWHERE
-mask
statement may specify the same construct-name.
END [ BLOCK DATA [ name ] ] |
The last statement of a block data subprogram.
If name is present, the BLOCK DATA
statement at the beginning of
the subprogram must have specified the same name.
END DO [ construct-name ] |
Marks the end of a DO
construct.
The construct-name shall be present if and only if it were present on the
DO
statement, and must be the same construct-name if so.
If the DO
statement specifies an ending label, the ENDDO
statement
must be labelled with that label.
ENDFILE expr |
ENDFILE ( position-spec-list ) |
(See the BACKSPACE
statement for the position-spec-list definition).
Writes an endfile record to the specified external file, truncating it at the current point.
END [ FUNCTION [ name ] ] |
The last statement of a function subprogram.
If the function subprogram is a contained subprogram, the keyword
FUNCTION
must be present. If name is present, it must be the name
of the function.
END IF [ construct-name ] |
Marks the end of an IF-THEN
construct.
The construct-name shall be present if and only if it were present on the
IF-THEN
statement, and must be the same construct-name if so.
END INTERFACE [ generic-spec ] |
Marks the end of an interface block.
If the INTERFACE
statement had a generic-spec, it may appear
on the ENDINTERFACE
statement.
END [ MODULE [ name ] ] |
The final statement of a module subprogram.
If name is present, it must match the name on the MODULE
statement.
END [ PROGRAM [ name ] ] |
The final statement of a main program unit.
If name is present, the main program must have a PROGRAM
statement
and the names must be the same.
END SELECT [ construct-name ] |
Marks the end of a SELECT
construct.
The construct-name shall be present if and only if it were present on the
SELECT
statement, and must be the same construct-name if so.
END TYPE [ name ] |
Marks the end of a derived type definition. If name is present it must be the name of the derived type.
ENDWHERE [ construct-name ] |
Marks the end of a WHERE
construct.
The construct-name shall be present if and only if it were present on
the WHERE
statement, and must be the same construct-name if so.
EQUIVALENCE equivalence-set [ , equivalence-set ]... |
equivalence-set ::= ( variable { , variable }... ) |
Declares each object in an equivalence-set to occupy the same storage.
ENTRY name [ ( [ arg-list ] ) ] |
Declares an additional entry point to the enclosing subprogram (entry points are not allowed in block data, main program, module and internal subprograms).
EXTERNAL name [ , name ]... |
Declares the listed names to be external subprograms or block data subprograms.
EXIT [ construct-name ] |
Transfers control to the statement following named DO
loop or, if
construct-name is omitted, the innermost enclosing DO
loop.
FORALL ( triplet-spec [ , triplet-spec ]... [ , expr ] ) forall-assignment-stmt |
triplet-spec ::= name = expr : expr [ : expr ] |
The iteration space of a FORALL
statement or construct is the
cross-product of the sets of possible index values defined by each triplet-spec masked by the final expr (if present). Note that the scope
of the index names is limited to the FORALL
statement – a variable with
the same name outside the FORALL
statement is unaffected.
The FORALL
statement executes the forall-assignment statement
for each index value set in the iteration space.
variable = expr |
variable => expr |
This is exactly like a normal assignment statement except that the expr is evaluated for each element of the iteration space before assignment or pointer assignment to each variable. Note that an assignment must not assign to the same element of an array more than once in the iteration space, and if the variable is scalar then the iteration space must be exactly one element.
FORALL ( triplet-spec [ , triplet-spec ]... [ , expr ] ) |
(See the FORALL
statement for the triplet-spec definition and
the explanation of the iteration space.)
Begins a FORALL
construct.
FORMAT ( [ format-list ] ) |
format-list ::= format-item [ , format-item ]... |
format-item ::= [ digit-string ] { data-edit | ( format-list ) } | other-edit |
data-edit ::= | { I | B | O | Z } digit-string [ . digit-string ] | |
{ F | D } digit-string . digit-string | | |
{ E | EN | ES | G } | |
digit-string . digit-string [ E digit-string ] | | |
L digit-string | | |
A [ digit-string ] |
other-edit ::= | digit-string { / | P | X } | |
{ T | TR | TL } digit-string | | |
character-literal | | |
digit-string H char... | | |
/ | : | BN | BZ | S | SP | SS |
Note: The character-literal must not have a kind-specifier.
The H
edit descriptor is followed by digit-string chars, which
may be any character except end-of-line; this edit descriptor is
obsolescent and the character-literal one should be used instead.
Note: The comma between format-items may be omitted as follows:
P
’ descriptor and a following ‘D
’,
‘E
’, ‘EN
’, ‘ES
’, ‘F
’ or
‘G
’ descriptor,
/
’ descriptor with no preceding digit-string,
/
’ descriptor and
:
’ descriptor.
[ prefix ] FUNCTION name ( [ name [ , name ] ... ] ) [ RESULT( name) ] |
prefix :: = { type-spec | RECURSIVE | PURE | ELEMENTAL }... |
Note: At most one occurrence of each prefix item is allowed.
This is the first statement of a function subprogram. If noRESULT
variable is specified the result variable has the same
name as the function name (thus for direct recursion, a RESULT
clause
is necessary as well as the RECURSIVE
keyword).
GOTO label |
Branches to the specified label, which must be on a branch target statement
(i.e., the subprogram END
statement, an executable statement, the
first statement of an executable construct or the last statement of an
enclosing executable construct).
IF ( expr ) executable |
Executes the sub-statement if and only if the condition is true.
The sub-statement cannot itself be an IF
statement.
[ construct-name : ] IF ( expr ) THEN |
Begins an IF-THEN
construct and the THEN
part thereof.
Statements in this part are executed if and only if the condition is true.
This statement may have a construct-name; if it does, the corresponding
ENDIF
statement shall have the same construct-name and intervening
ELSE
and ELSEIF
statements at the same level may have the same
construct-name.
IMPLICIT implicit-spec [ , implicit-spec ]... |
implicit-spec ::= type-spec ( letter-spec [ , letter-spec ] ... ) |
letter-spec ::= letter [ - letter ] |
Alters the implicit type mapping from the default. The default map is
IMPLICIT REAL(A-H,O-Z),INTEGER(I-N)in an external subprogram or interface body, and the same as the containing subprogram in a contained subprogram.
IMPLICIT NONE |
This statement sets the implicit type mapping for each letter to null, i.e.,
there are no implicit types.
It must occur before any PARAMETER
statements or other declarations
(but after any USE
statements).
INQUIRE ( IOLENGTH= object ) output-item [ , output-item ]... |
INQUIRE ( inquire-spec [ , inquire-spec ]... ) |
inquire-spec ::= | [ UNIT= ] expr | ACCESS= variable | ACTION= variable | BLANK= variable | CONVERT= variable | |
DELIM= variable | DIRECT= variable | ERR= label | EXIST= variable | FILE= expr | | |
FORM= variable | FORMATTED= variable | IOSTAT= variable | NAME= variable | | |
NAMED= variable | NEXTREC= variable | NUMBER= variable | OPENED= variable | | |
PAD= variable | POSITION= variable | READ= variable | READWRITE= variable | | |
RECL= variable | SEQUENTIAL= variable | UNFORMATTED= variable |
output-item ::= expr | ( { output-item , } ... do-spec ) |
The first form enquires as to the length needed to be specified for RECL=
in the OPEN
statement for an unformatted sequential file to be able to
write records as large as the output-item list.
The second form enquires either by unit or by file; exactly one UNIT=
or
FILE=
clause must be present (the UNIT=
keyword can be omitted if
it is the first inquire-spec).
If the FILE=
clause is used and that file is currently connected to a
unit, the effect is as if that unit were specified.
The effect of each clause is as below:
ACCESS=
'SEQUENTIAL'
if the unit is
connected for sequential access, to 'DIRECT'
if the unit is connected
for direct access, and to 'UNDEFINED'
if there is no connection.
ACTION=
'READ'
if the unit is connected
for input only, to 'WRITE'
if the unit is connected for output
only, to 'READWRITE'
if the unit is connected for both input and
output, and to 'UNDEFINED'
if there is no connection.
BLANK=
'NULL'
if blanks are treated as nulls on input and to 'ZERO'
if
they are treated as zeroes on input. Otherwise the object is set to
'UNDEFINED'
.
CONVERT=
'UNKNOWN'
if the file is not
connected for unformatted input/output, and otherwise to the value of the
CONVERT=
specifier in the OPEN
statement or as determined by the
FORT_CONVERT
n environment variable.
Possible values are 'NATIVE'
, 'BIG_NATIVE'
,
'LITTLE_NATIVE'
, 'BIG_IEEE'
, 'LITTLE_IEEE'
,
'BIG_IEEE_DD'
and 'LITTLE_IEEE_DD'
.
DELIM=
'APOSTROPHE'
if the apostrophe is
used to delimit character data in list-directed or namelist output for the
unit, to 'QUOTE'
if the quotation mark is to be so used, to 'NONE'
if no delimiter is to be used, and to 'UNDEFINED'
if there is no
connection.
DIRECT=
'YES'
if direct access is allowed
for the unit, to 'NO'
if direct access is not allowed, and to 'UNKNOWN'
if the answer cannot be determined.
ERR=
EXIST=
.TRUE.
if the file or unit
exists, and to .FALSE.
otherwise.
FORM=
'FORMATTED'
if the unit is connected
for formatted i/o, to 'UNFORMATTED'
if the unit is connected for
unformatted i/o, and to 'UNDEFINED'
if there is no connection.
FORMATTED=
'YES'
if formatted i/o is allowed
for the unit, to 'NO'
if it is not allowed, and to 'UNKNOWN'
if
the answer cannot be determined.
IOSTAT=
NAME=
NAMED=
.TRUE.
if the unit is connected
to a named file, and to .FALSE.
otherwise.
NEXTREC=
NUMBER=
-1
if the file is not connected to a unit.
OPENED=
.TRUE.
if the unit is connected
to a file (or the file is connected to a unit), and to .FALSE.
otherwise.
PAD=
'NO'
if the connection of the file to
the unit included the PAD='NO'
specifier; otherwise it is set to
'YES'
.
POSITION=
'REWIND'
if the unit is positioned at
the beginning of the file, to 'APPEND'
if it is positioned at the end of
the file, to 'ASIS'
if the unit was connected with that specification
(and no i/o or positioning has occurred since connection), to 'UNDEFINED'
if the unit is connected for direct access or there is no connection, and to
a processor-dependent value otherwise.
READ=
'YES'
if input is allowed for the
file or unit, to 'NO'
if input is not allowed for the file or unit, and
to 'UNKNOWN'
if the answer cannot be determined.
READWRITE=
'YES'
if both input and output are
allowed for the file or unit, to 'NO'
if at least one of input or output
is not allowed for the file or unit, and to 'UNKNOWN'
if the answer
cannot be determined.
RECL=
SEQUENTIAL=
'YES'
if sequential access is allowed
for the unit, to 'NO'
if sequential access is not allowed, and to
'UNKNOWN'
if the answer cannot be determined.
UNFORMATTED=
'YES'
if unformatted i/o is allowed
for the unit, to 'NO'
if it is not allowed, and to 'UNKNOWN'
if
the answer cannot be determined.
WRITE=
'YES'
if output is allowed for the
file or unit, to 'NO'
if output is not allowed for the file or unit, and
to 'UNKNOWN'
if the answer cannot be determined.
INTENT ( { IN | OUT | INOUT } ) [ :: ] name [ , name ]... |
Declares the specified names, which must be the names of dummy arguments, to
have the specified intent. INTENT(IN)
arguments cannot appear in any
context where they will be modified, INTENT(OUT)
arguments are
undefined on entry to the procedure, and INTENT(INOUT)
and INTENT(OUT)
arguments can only be associated with modifiable actual
arguments (e.g., not expressions).
INTERFACE |
INTERFACE { name | ASSIGNMENT(=) | OPERATOR( operator) } |
The first form introduces an interface block, containing interface bodies
which specify the interfaces to external or dummy procedures.
The second form additionally defines a generic name or operator by which
these procedures may be referenced, and its interface block may also contain
MODULE PROCEDURE
statements.
INTRINSIC name [ , name ]... |
Declares the listed names to be intrinsic procedures.
MODULE name |
This is the first statement of a module subprogram.
MODULE PROCEDURE name [ , name ]... |
This statement is only allowed within generic interface blocks, where it declares the listed names as module procedures to be included in the generic.
NAMELIST namelist-group [ [ , ] namelist-group ]... |
namelist-group ::= / name/ name [ , name ]... |
Declares one or more i/o namelists.
Multiple NAMELIST
specifications for the namelist group
/
name/
are treated as if they were concatenated.
The names in a namelist group must all be variables and not automatic,
adjustable, allocatable, pointer, or contain a pointer.
NULLIFY ( object [ , object ] ... ) |
Sets the pointer-association status of the listed objects, which must be pointers, to dissociated.
OPEN ( open-spec [ , open-spec ]... ) |
open-spec ::= | [ UNIT= ] expr | ACCESS= expr | ACTION= expr | BLANK= expr | CONVERT= expr | DELIM= expr | |
ERR= label | FILE= expr | FORM= expr | IOSTAT= object | PAD= expr | POSITION= expr | | |
RECL= expr | STATUS= expr |
Connects a file to a unit with the specified properties.
OPTIONAL [ :: ] name [ , name ]... |
Declares the specified names, which must be the names of dummy arguments, to be optional dummy arguments.
PARAMETER ( name = expr [ , name = expr ]... ) |
Declares the names to be named constants with the specified values. The expressions must be initialisation expressions and must be assignment compatible with the names.
PAUSE [ constant ] |
Pauses program execution. If present, the constant must be a scalar character literal with no kind-param or a digit-string with at most 5 digits.
POINTER [ :: ] name [ deferred-shape ] [ , name [ deferred-shape ] ]... |
Declares the names to be pointers.
variable => expr |
Associates the pointer variable with expr, which must be another
pointer, a variable with the TARGET
attribute, or a reference to a
function that returns a pointer result.
PRINT format [ , output-item ]... |
format ::= * | label | expr |
Synonymous with a WRITE
statement with ‘UNIT=*
’ and a
FMT=
format clause.
The possibilities for format are:
*
’FORMAT
statement.
FORMAT
of a FORMAT
statement.
If the expression is array-valued the concatenation of all elements is
interpreted in this way.
ASSIGN
ed the label of a FORMAT
statement.
PRIVATE [ [ :: ] access-id [ , access-id ]... ] |
access-id ::= name | ASSIGNMENT(=) | OPERATOR( operator) |
This statement can only occur in the declaration section of a module or before the component definitions in a type definition.
When this statement appears in a type definition, there can be no access-ids; it causes the components of the type to be inaccessible from outside the module in which the type is defined.
In a module's declaration section, this statement either sets the default
accessibility of entities within the module to be PRIVATE
, i.e., not
accessible, or the accessibility of each access-id is set to be
PRIVATE
.
PROGRAM name |
This is the first statement of a main program. It is optional.
PUBLIC [ [ :: ] access-id [ , access-id ]... ] |
This statement can only occur in the declaration section of a module.
With no access-id list, it confirms that the default accessibility of
entities in the module is PUBLIC
. With an access-id list, it
explicitly sets the accessibility of those access-ids to PUBLIC
.
READ format [ , input-item ]... |
READ ( control-spec [ , control-spec ]... ) [ input-item [ , input-item ]... ] |
input-item ::= variable | ( { input-item , }... do-spec ) |
control-spec ::= | [ UNIT= ] { * | expr } | |
[ FMT= ] format | [ NML= ] name | ADVANCE= expr | END= label | | |
EOR= label | ERR= label | IOSTAT= expr | REC= expr | SIZE= expr |
(See the PRINT
statement for format details.)
Reads one or more records (or partial records with ADVANCE='NO'
)
from the specified unit.
The effect of each control-specifier is as below:
UNIT=
FMT=
NML=
ADVANCE=
'NO'
) or
the usual advancing (expression evaluates to 'YES'
) i/o is performed.
This control-specifier is only allowed for formatted sequential i/o with
an explicit format (i.e., not namelist or list-directed).
END=
WRITE
).
EOR=
WRITE
). ADVANCE='NO'
must be
specified.
ERR=
IOSTAT=
REC=
SIZE=
WRITE
). ADVANCE='NO'
must be
specified.
RETURN [ expr ] |
Return immediately from the procedure. If the procedure is a subroutine with alternate return arguments (obsolescent), the scalar integer expression indicates to which label control is to be transferred on return (if the expression is less than one or greater than the number of alternate return arguments, execution continues with the statement following the subroutine reference).
REWIND expr |
REWIND ( position-spec-list ) |
(See the BACKSPACE
statement for the position-spec-list
definition).
Positions an i/o unit, which must be connected to a rewindable file, to the beginning of the file.
SAVE [ [ :: ] save-item [ , save-item ]... ] |
save-item ::= variable-name | / common-block-name/ |
Specifies the SAVE
attribute for the listed variables or common blocks,
or, with no save-item list, specifies that all possible variables and
common blocks in the current scoping unit should implicitly have the SAVE
attribute by default.
[ construct-name : ] SELECT CASE ( expr ) |
The initial statement of a SELECT CASE
construct.
Control is transferred to the CASE
statement satisfied by the
expression's value, or to the END SELECT
statement if no CASE
is satisfied by the value.
name ( [ name [ , name ] ... ] ) = expr |
Defines a statement function.
STOP [ constant ] |
Halts program execution. If present, the constant must be a scalar character literal with no kind-param or a digit-string with at most 5 digits.
[ RECURSIVE | PURE | ELEMENTAL ]... SUBROUTINE name [ ( [ arg-list ] ) ] |
(Note that at most one occurrence of each keyword is allowed).
arg-list ::= arg [ , arg ]... |
arg ::= name | * |
This is the first statement of a subroutine subprogram.
RECURSIVE
must be specified if the subroutine calls itself, either
directly or indirectly.
If PURE
is specified, the subroutine must satisfy the pure
subroutine constraints and can then be called from a pure function.
An arg that is ‘*
’ signfies an alternate return label; this
is obsolescent.
TARGET [ :: ] name [ array-spec ] [ , name [ array-spec ] ]... |
Declares that the specified entities have the TARGET attribute
.
TYPE name |
This statement marks the beginning of the definition of the derived type name.
type-spec [ [ , attr-spec ] ... :: ] entity-decl-list |
attr-spec ::= | ALLOCATABLE | DIMENSION array-spec | EXTERNAL | INTENT ( { IN | OUT | INOUT } ) | |
INTRINSIC | OPTIONAL | PARAMETER | POINTER | PRIVATE | PUBLIC | SAVE | TARGET |
Declares the listed entities to be of the specified type with the specified attributes.
USE name [ , rename-list ] |
USE name, ONLY: only-list |
rename-list ::= rename [ , rename ]... |
rename ::= local-name => remote-name |
only-list ::= only-item [ , only-item ]... |
only-item ::= name | rename |
The USE
statement accesses the named module.
Multiple USE
statements for the same module act as if all the
rename-lists and only-lists were concatenated.
If all the USE
statements in a scoping unit for a particular module
have the ONLY
clause, only those items listed in a rename-list or
only-list are accessible.
A rename causes item remote-name in the referenced module to be accessible in the local scoping unit by local-name. An only-item that is not a rename causes the name in the referenced module to be accessible in the local scoping unit by the same name.
variable = expr |
The expression is evaluated (and the object updated) only for those elements for which the current control mask is true.
WHERE ( expr ) where-assignment-stmt |
Executes the Where Assignment statement with the provided expression as the control mask.
[ construct-name : ] WHERE ( expr ) |
Begins a Where Construct with the provided expression as the control mask.
WRITE ( control-spec [ , control-spec ] ... ) output-item [ , output-item ]... |
(See the READ
statement for control-spec details.)
ADVANCE='NO'
)
to the specified unit.