An array specification (or array declarator) declares the shape of
an array. It takes the following form:
(array-spec)
array-spec Is one of the following array specifications:
Explicit-shape
Assumed-shape
Assumed-size
Deferred-shape
The array specification is appended to the name of the array when
the array is declared.
The following examples show different forms of array
specifications:
SUBROUTINE SUB(N, C, D, Z)
REAL, DIMENSION(N, 15) :: IARRY ! An explicit-shape array
REAL C(:), D(0:) ! An assumed-shape array
REAL, POINTER :: B(:,:) ! A deferred-shape array pointer
REAL :: Z(N,*) ! An assumed-size array
REAL, ALLOCATABLE, DIMENSION(:) :: K ! A deferred-shape
! allocatable array
1 – Explicit Shape
An explicit-shape array is declared with explicit values for the
bounds in each dimension of the array. An explicit-shape
specification takes the following form:
[lower-bound:] upper-bound [,[lower-bound:] upper-bound ]...
The lower bound (if present) and the upper bound are specification
expressions that have a positive, negative, or zero value. If
necessary, the bound value is converted to integer type.
If the lower bound is not specified, it is assumed to be 1.
The bounds can be specified as constant or nonconstant expressions,
as follows:
o If the bounds are constant expressions, the subscript range of
the array in a dimension is the set of integer values between
and including the lower and upper bounds. If the lower bound
is greater than the upper bound, the range is empty, the extent
in that dimension is zero, and the array has a size of zero.
o If the bounds are nonconstant expressions, the array must be
declared in a procedure. The bounds can have different values
each time the procedure is executed, since they are determined
when the procedure is entered.
The bounds are not affected by any redefinition or undefinition
of the specification variables that occurs while the procedure
is executing.
The following explicit-shape arrays can specify nonconstant
bounds:
- An automatic array (the array is a local
variable)
- An adjustable array (the array is a dummy
argument to a subprogram)
The following are examples of explicit-shape specifications:
INTEGER I(3:8, -2:5) ! Rank-two array; range of dimension one is
... ! 3 to 8, range of dimension two is -2 to 5
SUBROUTINE SUB(A, B, C)
INTEGER :: B, C
REAL, DIMENSION(B:C) :: A ! Rank-one array; range is B to C
1.1 – Automatic Arrays
An automatic array is an explicit-shape array that is a local
variable. Automatic arrays are only allowed in function and
subroutine subprograms, and are declared in the specification part
of the subprogram. At least one bound of an automatic array must
be a nonconstant specification expression. The bounds are
determined when the subprogram is called.
The following example shows automatic arrays:
SUBROUTINE SUB1 (A, B)
INTEGER A, B, LOWER
COMMON /BOUND/ LOWER
...
INTEGER AUTO_ARRAY1(B)
...
INTEGER AUTO_ARRAY2(LOWER:B)
...
INTEGER AUTO_ARRAY3(20, B*A/2)
END SUBROUTINE
1.2 – Adjustable Arrays
An adjustable array is an explicit-shape array that is a dummy
argument to a subprogram. At least one bound of an adjustable
array must be a nonconstant specification expression. The bounds
are determined when the subprogram is called.
The array specification can contain integer variables that are
either dummy arguments or variables in a common block.
When the subprogram is entered, each dummy argument specified in
the bounds must be associated with an actual argument. If the
specification includes a variable in a common block, it must have a
defined value. The array specification is evaluated using the
values of the actual arguments, as well as any constants or common
block variables that appear in the specification.
The size of the adjustable array must be less than or equal to the
size of the array that is its corresponding actual argument.
To avoid possible errors in subscript evaluation, make sure that
the bounds expressions used to declare multidimensional adjustable
arrays match the bounds as declared by the caller.
In the following example, the function computes the sum of the
elements of a rank-two array. Notice how the dummy arguments M and
N control the iteration:
FUNCTION MY_SUM(A, M, N)
DIMENSION A(M, N)
SUMX = 0.0
DO J = 1, N
DO I = 1, M
SUMX = SUMX + A(I, J)
END DO
END DO
MY_SUM = SUMX
END FUNCTION
The following are examples of calls on SUM:
DIMENSION A1(10,35), A2(3,56)
SUM1 = MY_SUM(A1,10,35)
SUM2 = MY_SUM(A2,3,56)
2 – Assumed Shape
An assumed-shape array is a dummy argument array that assumes the
shape of its associated actual argument array. An assumed-shape
specification takes the following form:
[lower-bound]: [,[lower-bound]:] ...
The lower bound is a specification expression. If the lower bound
is not specified, it is assumed to be 1.
The rank of the array is the number of colons (:) specified.
The value of the upper bound is the extent of the corresponding
dimension of the associated actual argument array + lower-bound -
1.
The following is an example of an assumed-shape specification:
INTERFACE
SUBROUTINE SUB(M)
INTEGER M(:, 1:, 5:)
END SUBROUTINE
END INTERFACE
INTEGER L(20, 5:25, 10)
CALL SUB(L)
SUBROUTINE SUB(M)
INTEGER M(:, 1:, 5:)
END SUBROUTINE
Array M has the same extents as array L, but array M has bounds
(1:20, 1:21, 5:14).
Note that an explicit interface is required when calling a routine
that expects an assumed-shape or pointer array.
3 – Assumed Size
An assumed-size array is a dummy argument array that assumes the
size (only) of its associated actual argument array; the rank and
extents can differ for the actual and dummy arrays. An
assumed-size specification takes the following form:
[exp-shape-spec,] [exp-shape-spec,]... [lower-bound:] *
The exp-shape-spec is an explicit-shape specification (see DATA
ARRAY DECL EXPL in online Help).
The lower bound and upper bound are specification expressions that
have a positive, negative, or zero value. If necessary, the bound
value is converted to integer type. If a lower bound is not
specified, it is assumed to be 1.
The asterisk (*) represents the upper bound of the last dimension.
The rank of the array is the number of explicit-shape
specifications plus 1.
The size of the array is assumed from the actual argument
associated with the assumed-size dummy array as follows:
o If the actual argument is an array of type other than default
character, the size of the dummy array is the size of the
actual array.
o If the actual argument is an array element of type other than
default character, the size of the dummy array is a + 1 - s,
where "s" is the subscript value and "a" is the size of the
actual array.
o If the actual argument is a default character array, array
element, or array element substring, and it begins at character
storage unit b of an array with n character storage units, the
size of the dummy array is as follows:
MAX(INT((n + 1 - b) / y), 0)
The "y" is the length of an element of the dummy array.
An assumed-size array can only be used as a whole array reference
in the following cases:
o When it is an actual argument in a procedure reference that
does not require the shape
o In the intrinsic function LBOUND
Because the actual size of an assumed-size array is unknown, an
assumed-size array cannot be used as any of the following in an I/O
statement:
o An array name in the I/O list
o A unit identifier for an internal file
o A run-time format specifier
The following is an example of an assumed-size specification:
SUBROUTINE SUB(A, N)
REAL A, N
DIMENSION A(1:N, *)
...
4 – Deferred Shape
A deferred-shape array is an array pointer or an allocatable array.
The array specification contains a colon (:) for each dimension of
the array. No bounds are specified. The bounds (and shape) of
allocatable arrays and array pointers are determined when space is
allocated for the array during program execution.
An array pointer is an array declared with the POINTER attribute.
Its bounds and shape are determined when it is associated with a
target by pointer assignment, or when the pointer is allocated by
execution of an ALLOCATE statement.
In pointer assignment, the lower bound of each dimension of the
array pointer is the result of the LBOUND intrinsic function
applied to the corresponding dimension of the target. The upper
bound of each dimension is the result of the UBOUND intrinsic
function applied to the corresponding dimension of the target.
A pointer dummy argument can be associated only with a pointer
actual argument. An actual argument that is a pointer can be
associated with a nonpointer dummy argument.
A function result can be declared to have the pointer attribute.
An allocatable array is declared with the ALLOCATABLE attribute.
Its bounds and shape are determined when the array is allocated by
execution of an ALLOCATE statement.
The following are examples of deferred-shape specifications:
REAL, ALLOCATABLE :: A(:,:) ! Allocatable array
REAL, POINTER :: C(:), D (:,:,:) ! Array pointers