[ HPF Home | Versions | Compilers | Projects | Publications | Applications | Benchmarks | Events | Contact ] |
PROGRAM EXAMPLE
! Declare the data array and a verification copy
INTEGER, PARAMETER :: NX = 100,
NY = 100
REAL, DIMENSION(NX,NY) :: X, Y
!HPF$ DISTRIBUTE(BLOCK,BLOCK) :: X, Y
! The global sum will be computed
! by forming partial sums on the processors
REAL PARTIAL_SUM(NUMBER_OF _PROCESSORS())
!HPF$ DISTRIBUTE PARTIAL_SUM(BLOCK)
! Local subgrid parameters are declared per processor
! for a rank-two array
INTEGER, DIMENSION(NUMBER_OF_PROCESSORS(),2)
::
& LB, UB, NUMBER
!HPF$ DISTRIBUTE(BLOCK,*) :: LB, UB, NUMBER
! Define interfaces
INTERFACE
EXTRINSIC(F77_LOCAL)
SUBROUTINE_LOCAL1
& ( LB1, UB1, LB2, UB2, NX,
X )
! Arrays LB1, UB1, UB2, and X are passed by default
! as LAYOUT('F77_ARRAY') and PASS_BY('*')
INTEGER, DIMENSION(:)
:: LB1, UB1, LB2, UB2
INTEGER NX
REAL X(:,:)
!HPF$ DISTRIBUTE (BLOCK) :: LB1, UB1, LB2, UB2
!HPF$ DISTRIBUTE(BLOCK,BLOCK) :: X
END
EXTRINSIC(F77_LOCAL)
SUBROUTINE LOCAL2(N,X,R)
! Arrays N, X, and R are passed by default
! as LAYOUT('F77_ARRAY') and PASS_BY('*')
INTEGER N(:)
REAL X(:,:), R(:)
!HPF$ DISTRIBUTE N(BLOCK)
!HPF$ DISTRIBUTE X(BLOCK,BLOCK)
!HPF$ DISTRIBUTE R(BLOCK)
END
END INTERFACE
! Determine result using only global HPF
! Initialize values
FORALL (I=1:NX,J=1:NY) X(I,J) =
I + (J-1) * NX
! Determine and report global sum
PRINT *, 'GLOBAL HPF RESULT: ',SUM(X)
! Determine result using local subroutines
! Initialize values ( assume stride
= 1 )
CALL HPF_SUBGRID_INFO( Y, IERR,
LB=LB, UB=UB )
IF (IERR.NE.0) STOP 'ERROR!'
CALL LOCAL1( LB(:,1), UB(:,1), LB(:,2),
UB(:,2), NX, Y )
! Determine and report global sum
NUMBER = UB - LB + 1
CALL LOCAL2 ( NUMBER(:,1) * NUMBER(:,2)
, Y , PARTIAL_SUM )
PRINT *, 'F77_LOCAL RESULT #1 :
',SUM(PARTIAL_SUM)
END
©2000-2006 Rice University | [ Contact Us | HiPerSoft | Computer Science ] |