In Fortran 2003 the ALLOCATABLE attribute is permitted not just on
local variables but also on components, dummy variables, and function
results.
These are the same as described in the ISO Technical Report
ISO/IEC TR 15581:1999.
Also, the MOVE_ALLOC intrinsic subroutine has been added, as well as
automatic reallocation on assignment.
SUBROUTINE s(dum)
REAL,ALLOCATABLE :: dum(:,:)
...
END SUBROUTINE
Having an allocatable dummy argument means that there must be an explicit interface for any reference: i.e. if the procedure is not an internal or module procedure there must be an accessible interface block in any routine which references that procedure.
Any actual argument that is passed to an allocatable dummy array must itself be an allocatable array; it must also have the same type, kind type parameters, and rank. For example:
REAL,ALLOCATABLE :: x(:,:) CALL s(x)
The actual argument need not be allocated before calling the procedure, which may itself allocate or deallocate the argument. For example:
PROGRAM example2
REAL,ALLOCATABLE :: x(:,:)
OPEN(88,FILE='myfile',FORM='unformatted')
CALL read_matrix(x,88)
!
... process x in some way
!
REWIND(88)
CALL write_and_delete_matrix(x,88)
END
!
MODULE module
CONTAINS
!
! This procedure reads the size and contents of an array from an
! unformatted unit.
!
SUBROUTINE read_matrix(variable,unit)
REAL,ALLOCATABLE,INTENT(OUT) :: variable(:,:)
INTEGER,INTENT(IN) :: unit
INTEGER dim1,dim2
READ(unit) dim1,dim2
ALLOCATE(variable(dim1,dim2))
READ(unit) variable
CLOSE(unit)
END SUBROUTINE
!
! This procedures writes the size and contents of an array to an
! unformatted unit, and then deallocates the array.
!
SUBROUTINE write_and_delete_matrix(variable,unit)
REAL,ALLOCATABLE,INTENT(INOUT) :: variable(:,:)
INTEGER,INTENT(IN) :: unit
WRITE(unit) SIZE(variable,1),SIZE(variable,2)
WRITE(unit) variable
DEALLOCATE(variable)
END SUBROUTINE
END
FUNCTION af() RESULT(res)
REAL,ALLOCATABLE :: res
On invoking the function, the result variable will be unallocated. It must be allocated before returning from the function. For example:
!
! The result of this function is the original argument with adjacent
! duplicate entries deleted (so if it was sorted, each element is unique).
!
FUNCTION compress(array)
INTEGER,ALLOCATABLE :: compress(:)
INTEGER,INTENT(IN) :: array(:)
IF (SIZE(array,1)==0) THEN
ALLOCATE(compress(0))
ELSE
N = 1
DO I=2,SIZE(array,1)
IF (array(I)/=array(I-1)) N = N + 1
END DO
ALLOCATE(compress(N))
N = 1
compress(1) = array(1)
DO I=2,SIZE(array,1)
IF (array(I)/=compress(N)) THEN
N = N + 1
compress(N) = array(I)
END IF
END DO
END IF
END
The result of an allocatable array is automatically deallocated after it has been used.
MODULE matrix_example
TYPE MATRIX
REAL,ALLOCATABLE :: value(:,:)
END TYPE
END MODULE
An allocatable array component is initially not allocated, just like allocatable array variables. On exit from a procedure containing variables with allocatable components, all the allocatable components are automatically deallocated. This is in contradistinction to pointer components, which are not automatically deallocated. For example:
SUBROUTINE sub(n,m)
USE matrix_example
TYPE(matrix) a,b,c
!
! a%value, b%value and c%value are all unallocated at this point.
!
ALLOCATE(a%value(n,m),b%value(n,m))
!
... do some computations, then
!
RETURN
!
! Returning from the procedure automatically deallocates a%value, b%value,
! and c%value (if they are allocated).
!
END
Deallocating a variable that has an allocatable array component deallocates the
component first; this happens recursively so that all ALLOCATABLE
subobjects are deallocated with no memory leaks.
Any allocated allocatable components of a function result are automatically deallocated after the result has been used.
PROGRAM deallocation_example
TYPE inner
REAL,ALLOCATABLE :: ival(:)
END TYPE
TYPE outer
TYPE(inner),ALLOCATABLE :: ovalue(:)
END TYPE
TYPE(outer) x
!
! At this point, x%ovalue is unallocated
!
ALLOCATE(x%ovalue(10))
!
! At this point, x%ovalue(i)%ival are unallocated, i=1,10
!
ALLOCATE(x%ovalue(2)%ival(1000),x%ovalue(5)%ival(9999))
!
! Only x%ovalue(2)%ival and x%ovalue(5)%ival are allocated
!
DEALLOCATE(x%ovalue)
!
! This has automatically deallocated x%ovalue(2)%ival and x%ovalue(5)%ival
!
END
In a structure constructor for such a type, the expression corresponding to
an allocatable array component can be
SUBROUTINE constructor_example
USE matrix_example
TYPE(matrix) a,b,c
REAL :: array(10,10) = 1
REAL,ALLOCATABLE :: alloc_array(:,:)
a = matrix(NULL())
!
! At this point, a%value is unallocated
!
b = matrix(array*2)
!
! Now, b%value is a (10,10) array with each element equal to 2.
!
c = matrix(alloc_array)
!
! Now, c%value is unallocated (because alloc_array was unallocated).
!
END
Intrinsic assignment of such types does a “deep copy” of the allocatable array components; it is as if the allocatable array component were deallocated (if necessary), then if the component in the expression was allocated, the variable's component is allocated to the right size and the value copied.
SUBROUTINE assignment_example
USE matrix_example
TYPE(matrix) a,b
!
! First we establish a value for a
!
ALLOCATE(a%value(10,20))
a%value(3,:) = 30
!
! And a value for b
!
ALLOCATE(b%value(1,1))
b%value = 0
!
! Now the assignment
!
b = a
!
! The old contents of b%value have been deallocated, and b%value now has
! the same size and contents as a%value.
!
END
!
! Module providing a single-precision polynomial arithmetic facility
!
MODULE real_poly_module
!
! Define the polynomial type with its constructor.
! We will use the convention of storing the coefficients in the normal
! order of highest degree first, thus in an N-degree polynomial, COEFF(1)
! is the coefficient of X**N, COEFF(N) is the coefficient of X**1, and
! COEFF(N+1) is the scalar.
!
TYPE,PUBLIC :: real_poly
REAL,ALLOCATABLE :: coeff(:)
END TYPE
!
PUBLIC OPERATOR(+)
INTERFACE OPERATOR(+)
MODULE PROCEDURE rp_add_rp,rp_add_r,r_add_rp
END INTERFACE
!
CONTAINS
TYPE(real_poly) FUNCTION rp_add_r(poly,real)
TYPE(real_poly),INTENT(IN) :: poly
REAL,INTENT(IN) :: real
INTEGER isize
IF (.NOT.ALLOCATED(poly%coeff)) STOP 'Undefined polynomial value in +'
isize = SIZE(poly%coeff,1)
rp_add_r%coeff(isize) = poly%coeff(isize) + real
END FUNCTION
TYPE(real_poly) FUNCTION r_add_rp(real,poly)
TYPE(real_poly),INTENT(IN) :: poly
REAL,INTENT(IN) :: real
r_add_rp = rp_add_r(poly,real)
END FUNCTION
TYPE(real_poly) FUNCTION rp_add_rp(poly1,poly2)
TYPE(real_poly),INTENT(IN) :: poly1,poly2
INTEGER I,N,N1,N2
IF (.NOT.ALLOCATED(poly1%coeff).OR..NOT.ALLOCATED(poly2%coeff)) &
STOP 'Undefined polynomial value in +'
! Set N1 and N2 to the degrees of the input polynomials
N1 = SIZE(poly1%coeff) - 1
N2 = SIZE(poly2%coeff) - 1
! The result polynomial is of degree N
N = MAX(N1,N2)
ALLOCATE(rp_add_rp%coeff(N+1))
DO I=0,MIN(N1,N2)
rp_add_rp%coeff(N-I+1) = poly1%coeff(N1-I+1) + poly2%coeff(N2-I+1)
END DO
! At most one of the next two DO loops is ever executed
DO I=N1+1,N
rp_add_rp%coeff(N-I+1) = poly2%coeff(N2-I+1)
END DO
DO I=N2+1,N
rp_add_rp%coeff(N-I+1) = poly1%coeff(N1-I+1)
END DO
END FUNCTION
END MODULE
!
! Sample program
!
PROGRAM example
USE real_poly_module
TYPE(real_poly) p,q,r
p = real_poly((/1.0,2.0,4.0/)) ! x**2 + 2x + 4
q = real_poly((/1.0,-5.5/)) ! x - 5.5
r = p + q ! x**2 + 3x - 1.5
print 1,'The coefficients of the answer are:',r%coeff
1 format(1x,A,3F8.2)
END
When executed, the above program prints:
The coefficients of the answer are: 1.00 3.00 -1.50
REAL,ALLOCATABLE :: a(:),tmp(:) ... ALLOCATE(a(n)) ... ! Here we want to double the size of A, without losing any of the values ! that are already stored in it. ALLOCATE(tmp(size(a)*2)) tmp(1:size(a)) = a CALL move_alloc(from=tmp,to=a) ! TMP is now deallocated, and A has the new size and values.To have the values end up somewhere different, just change the assignment statement, for example to move them all to the end:
tmp(size(a)+1:size(a)*2) = a
CLASS) and/or
deferred type parameters (e.g. CHARACTER(:)); for more details see
the “Typed allocation”,
“Sourced allocation” and
“Automatic reallocation” sections.
ALLOCATE(a(10)) ... a = (/ (i,i=1,100) /) ! A is now size 100
Similarly, if an allocatable variable has a deferred type parameter (these are described in a later section), and is either unallocated or has a value different from that of the expression, the allocatable variable is reallocated to have the same value for that type parameter. This allows for true varying-length character variables:
CHARACTER(:),ALLOCATABLE :: name ... name = 'John Smith' ! LEN(name) is now 10, whatever it was before. name = '?' ! LEN(name) is now 1.Note that since a subobject of an allocatable object is not itself allocatable, this automatic reallocation can be suppressed by using substrings (for characters) or array sections (for arrays), e.g.
name(:) = '?' ! Normal assignment with truncation/padding. a(:) = (/ (i,i=1,100) /) ! Asserts that A is already of size 100.