next up previous index
Next: Specification Statements Up: Fortran 90 Tutorial Previous: Array handling

Pointers

 

Basics

 

Pointers are variables with the POINTER attribute; they are not a distinct data type (and so no ``pointer arithmetic'' is possible):

          REAL, POINTER :: var
They are conceptually a descriptor listing the attributes of the objects (targets) that the pointer may point to, and the address, if any, of a target. They have no associated storage until it is allocated or otherwise associated (by pointer assignment  , see below):
          ALLOCATE (var)
and they are dereferenced automatically, so no special symbol is required. In
                  var = var + 2.3
the value of the target of var is used and modified. Pointers cannot be transferred via I/O--the statement
                 WRITE *, var
writes the value of the target of var and not the pointer descriptor itself.

A pointer can point to other pointers, and hence to their targets  , or to a static object that has the TARGET attribute:

          REAL, POINTER :: object
          REAL, TARGET  :: target_obj
          var => object                  ! pointer assignment
          var => target_obj
but they are strongly typed:
          INTEGER, POINTER :: int_var
          var => int_var                 ! illegal - types must match
and, similarly, for arrays the ranks as well as the type must agree.

A pointer can be a component of a derived data type  :

        TYPE entry                       ! type for sparse matrix
           REAL value
           INTEGER index
           TYPE(entry), POINTER :: next  ! note recursion
        END TYPE entry
and we can define the beginning of a linked chain  of such entries:
        TYPE(entry), POINTER :: chain
After suitable allocations and definitions, the first two entries could be addressed as
        chain%value           chain%next%value
        chain%index           chain%next%index
        chain%next            chain%next%next
but we would normally define additional pointers to point at, for instance, the first and current entries in the list.

Association

 

A pointer's association status is one of

  1. undefined (initial state);
  2. associated (after allocation or a pointer assignment);
  3. disassociated:
              DEALLOCATE (p, q)  ! for returning storage
              NULLIFY (p, q)     ! for setting to 'null'
    
Some care has to be taken not to leave a pointer ``dangling'' by use of DEALLOCATE on its target without NULLIFYing any other pointer referring to it.

The intrinsic function  ASSOCIATED can test the association status of a defined pointer:

               IF (ASSOCIATED(pointer)) THEN
or between a defined pointer and a defined target (which may, itself, be a pointer):
               IF (ASSOCIATED(pointer, target)) THEN

Pointers in expressions and assignments

 

For intrinsic types we can ``sweep'' pointers over different sets of target data using the same code without any data movement. Given the matrix manipulation y = B C z, we can write the following code (although, in this case, the same result could be achieved more simply by other means):

      REAL, TARGET  :: b(10,10), c(10,10), r(10), s(10, z(10)
      REAL, POINTER :: a(:,:), x(:), y(:)
      INTEGER mult
      :
      DO mult = 1, 2
         IF (mult == 1) THEN
            y => r              ! no data movement
            a => c
            x => z
         ELSE
            y => s              ! no data movement
            a => b
            x => r
         END IF
         y = MATMUL(a, x)       ! common calculation
      END DO
For objects of derived data type  we have to distinguish between pointer and normal assignment . In
      TYPE(entry), POINTER :: first, current
      :
      first => current
the assignment causes first to point at current, whereas
      first =  current
causes current to overwrite first and is equivalent to
      first%value = current%value
      first%index = current%index
      first%next => current%next

Pointer arguments

 

If an actual argument  is a pointer then, if the dummy argument  is also a pointer,

  1. it must have same rank  ,
  2. it receives its association status from the actual argument,
  3. it returns its final association status to the actual argument (note: the target may be undefined!),
  4. it may not have the INTENT attribute (it would be ambiguous),
  5. it requires an interface block  .
If the dummy argument is not a pointer, it becomes associated with the target of the actual argument:
     REAL, POINTER :: a(:,:)
        :
     ALLOCATE (a(80, 80))
        :
     CALL sub(a)
        :
  SUBROUTINE sub(c)
     REAL c(:, :)

Pointer functions

 

Function results may also have the POINTER attribute; this is useful if the result size depends on calculations performed in the function, as in

     USE data_handler
     REAL x(100)
     REAL, POINTER :: y(:)
     :
     y => compact(x)
where the module data_handler contains
     FUNCTION compact(x)
        REAL, POINTER :: compact(:)
        REAL x(:)
  ! A procedure to remove duplicates from the array x
        INTEGER n
        :              ! Find the number of distinct values, n
        ALLOCATE(compact(n))
        :              ! Copy the distinct values into compact
     END FUNCTION compact
The result can be used in an expression (but must be associated with a defined target).

Arrays of pointers

   

These do not exist as such: given

     TYPE(entry) :: rows(n)
then
     rows%next              ! illegal
would be such an object, but with an irregular storage pattern. For this reason they are not allowed. However, we can achieve the same effect by defining a derived data type with a pointer as its sole component:
     TYPE row
        REAL, POINTER :: r(:)
     END TYPE
and then defining arrays of this data type:
     TYPE(row) :: s(n), t(n)
where the storage for the rows can be allocated by, for instance,
     DO i = 1, n
        ALLOCATE (t(i)%r(1:i)) ! Allocate row i of length i
     END DO
The array assignment
     s = t
is then equivalent to the pointer assignments 
     s(i)%r => t(i)%r
for all components.

Pointers as dynamic aliases

   

Given an array

     REAL, TARGET :: table(100,100)
that is frequently referenced with the fixed subscripts
     table(m:n, p:q)
these references may be replaced by
     REAL, DIMENSION(:, :), POINTER :: window
       :
     window => table(m:n, p:q)
The subscripts  of window are 1:n-m+1, 1:q-p+1. Similarly, for
           tar%u
(as defined in chapter gif, page gif), we can use, say,
           taru => tar%u
to point at all the u components of tar, and subscript it as
           taru(1, 2)
The subscripts are as those of tar itself. (This replaces yet more of EQUIVALENCE.)

The source code of an extended example of the use of pointers to support a data structure is here.



next up previous index
Next: Specification Statements Up: Fortran 90 Tutorial Previous: Array handling


Michel Goossens Mon Dec 18 12:34:22 MET 1995