next up previous contents
Next: The ON Directive Up: Active Processor Sets Previous: Mapping Local Objects and

Other Restrictions on Active Processors

In addition to the mapping of locals and dummy arguments, several other constructs are restricted when the active processor set does not match the universal processor set. In general, the intent of these restrictions is to ensure that all processors that are needed for an operation are active when it is performed. In particular, allocating or freeing memory mapped to a processor requires the cooperation of that processor.

For a REDISTRIBUTE directive, the active processor set must include:

This implies that all elements of the redistributed object reside on active processors, both before and after the REDISTRIBUTE operation. Effectively, this means that all data movement for the REDISTRIBUTE will be among active processors. In addition, the processors that owned the distributee (or anything aligned to it) beforehand can free the memory, and processors that now own the distributee can allocate memory for it.

Similarly, for a REALIGN directive, the set of active processors must include all processors that stored elements of the alignee before the REALIGN and all processors that will store alignee elements after the REALIGN.

For an ALLOCATE statement that creates an explicitly mapped object, the set of active processors must include the processors used by the mapping directive for the allocated object. The allocated object's ultimate align target may fall into one of two classes:

For example:
!HPF$ ON (P(1:4))
      CALL OF_THE_WILD()
      ...

      SUBROUTINE OF_THE_WILD()
      INTEGER, ALLOCATABLE, DIMENSION(:) :: A, B, C, D, E, F
!HPF$ PROCESSORS P(NUMBER_OF_PROCESSORS()), ONE_P
!HPF$ PROCESSORS, SUBSET :: Q(ACTIVE_NUM_PROCS())
!HPF$ DISTRIBUTE (BLOCK) :: A, E
!HPF$ DISTRIBUTE (BLOCK) ONTO P(1:4) :: B
!HPF$ DISTRIBUTE (*) ONTO ONE_P :: C
!HPF$ DISTRIBUTE (BLOCK) ONTO Q :: D, F

      ALLOCATE (A(100))   ! No explicit ONTO; block size is probably 25
      ALLOCATE (B(100))   ! Block size IS 25
      ALLOCATE (C(100))   ! On one active processor
      ALLOCATE (D(100))   ! On Q(1:4); block size 25
!HPF$ ON HOME(B(1:50)) BEGIN
      ALLOCATE (E(100))   ! No ONTO; E is allocated on Q(1:2)
      ALLOCATE (F(100))   ! Nonconforming since Q(3:4) are inactive
!HPF$ END ON

For a DEALLOCATE statement that destroys an explicitly mapped object, the active processor set must include all processors that own any element of that object. Again, there are two cases for the deallocated object's ultimate align target:

An example may be helpful:

      REAL, ALLOCATABLE :: X(:), Y(:)
!HPF$ PROCESSORS P(8)
!HPF$ DISTRIBUTE X(BLOCK) ONTO P(1:4)
!HPF$ DISTRIBUTE Y(CYCLIC)

!HPF$ ON ( P(1:6) )
!HPF$     ON ( P(1:5) )
              ALLOCATE( X(1000), Y(1000)
!HPF$         ON ( P(1:3) )
                  ! Point 1
!HPF$         END ON
              ! Point 2
!HPF$     END ON
         ! Point 3
!HPF$ END ON
      ...
!HPF$ ON ( P(1:4) )
          ! Point 4
!HPF$ END ON
      ! Point 5

At point 1, neither X nor Y can be deallocated, since some of the processors that store their elements might not be active. If the innermost directive were

!HPF$       ON ( P(1:4) )

then X could be safely deallocated because of its explicit ONTO clause; it would still be incorrect to deallocate Y. At points 2 and  3, both X and Y can safely be deallocated. In general, if the deallocation occurs at the same level of ON nesting or at an outer level and the flow of control has not left the outer ON construct, then the deallocation is safe. At point 4 it is correct to deallocate X because its ONTO clause matches the enclosing ON. It is not, however, correct to deallocate Y, since some processors (e.g., P(5)) that were active at the ALLOCATE statement are not active at point 4. This illustrates the care that must be exercised if a DEALLOCATE statement is controlled by an ON clause. One can avoid potential problems by performing the deallocation outside of any ON construct in the same procedure, as at point 5.

It is possible that only of subset of the processors active at allocation time and named in the ONTO clause actually store part of the object:

!HPF$ DISTRIBUTE A(BLOCK(10)) ONTO P(1:4)
      INTEGER, ALLOCATABLE :: A(:)
      ALLOCATE A(10)
!HPF$ ON (P(1))
      DEALLOCATE(A)     ! Correct, because only P(1) owns any part of A


next up previous contents
Next: The ON Directive Up: Active Processor Sets Previous: Mapping Local Objects and