next up previous contents
Next: Procedures Up: Life in a Procedure Previous: Life in a Procedure

Solution

4 marks. Important parts are INTERFACE and descriptive distributions.

(Unfortunately this reveals an internal error in v2.0 of the PGI compiler. v2.1 is OK)

      MODULE Processor_Grid
       !HPF$ PROCESSORS, DIMENSION(2,2)   :: square
      END MODULE Processor_Grid

      PROGRAM life_subroutine
       USE Processor_Grid
        IMPLICIT NONE
        INTEGER, PARAMETER                   :: N=32 ! board size
        INTEGER, PARAMETER                   :: MAXLOOP=2 ! Iterations
        INTEGER, DIMENSION(N,N)              :: board
  !HPF$ DISTRIBUTE (BLOCK,BLOCK) ONTO square :: board

        CHARACTER*(10) picfile

        INTERFACE
         SUBROUTINE update_life(board, iterations)
          USE Processor_Grid
          INTEGER, DIMENSION(:,:), INTENT(INOUT) :: board
          INTEGER,                 INTENT(IN)    :: iterations
          INTEGER, DIMENSION(SIZE(board,1),SIZE(board,2)) :: neighbours
    !HPF$ ALIGN (:,:) WITH board(:,:)            :: neighbours
    !HPF$ DISTRIBUTE *(BLOCK,BLOCK) ONTO *square :: board
         END SUBROUTINE update_life
        END INTERFACE

! Initialise board

       board = 0
       board(N/2,:) = 1
       board(:,N/2) = 1

! Print starting config to file life00.pgm

       WRITE(picfile, 20) 0
 20    FORMAT('life', i2.2, '.pgm')

       OPEN(UNIT=10, FILE=picfile)
       WRITE(10, FMT='(''P2'',/,i3,2x,i3,/,i3)') N, N, 1
       WRITE(10,*) board
       CLOSE(UNIT=10)

! Perform MAXLOOP updates

       CALL update_life(board, MAXLOOP)


      END


      SUBROUTINE update_life(board, iterations)
       USE Processor_Grid
       IMPLICIT NONE
       INTEGER, DIMENSION(:,:), INTENT(INOUT) :: board
       INTEGER,                 INTENT(IN)    :: iterations
       INTEGER, DIMENSION(SIZE(board,1),SIZE(board,2)) :: neighbours
 !HPF$ ALIGN (:,:) WITH board(:,:)            :: neighbours
 !HPF$ DISTRIBUTE *(BLOCK,BLOCK) ONTO *square :: board

       INTEGER loop

       CHARACTER*(10) picfile

       DO loop = 1, iterations

! Count number of neighbours
!
        neighbours =
     &    CSHIFT(board, SHIFT= 1, DIM=1) +
     &    CSHIFT(board, SHIFT=-1, DIM=1) +
     &    CSHIFT(board, SHIFT= 1, DIM=2) +
     &    CSHIFT(board, SHIFT=-1, DIM=2) +
     &    CSHIFT(CSHIFT(board, SHIFT= 1, DIM=2), SHIFT= 1, DIM=1) +
     &    CSHIFT(CSHIFT(board, SHIFT= 1, DIM=2), SHIFT=-1, DIM=1) +
     &    CSHIFT(CSHIFT(board, SHIFT=-1, DIM=2), SHIFT= 1, DIM=1) +
     &    CSHIFT(CSHIFT(board, SHIFT=-1, DIM=2), SHIFT=-1, DIM=1)

! Calculate new generation
!
       WHERE (neighbours.lt.2 .or. neighbours.gt.3)
        board = 0
       END WHERE
       WHERE (neighbours.eq.3)
        board = 1
       END WHERE

! Write out new state of board
!
        WRITE(picfile, 20) loop
 20     FORMAT('life', i2.2, '.pgm')
        OPEN(UNIT=10, FILE=picfile)
        WRITE(10, FMT='(''P2'',/,i3,2x,i3,/,i3)')
     &        SIZE(board,1), SIZE(board,2), 1
        WRITE(10,*) board
        CLOSE(10)

      END DO

      END SUBROUTINE

This works but is not such a good solution:

      PROGRAM life_subroutine
      IMPLICIT NONE

! This code performs MAXLOOP iterations of an NxN life board
!
      INTEGER, PARAMETER :: N=32, MAXLOOP=2

! Declare processor grid
!
!HPF$ PROCESSORS, DIMENSION(2,2) :: square

! Declare and distribute main arrays
!
      INTEGER, DIMENSION(N,N) :: board, neighbours
!HPF$ DISTRIBUTE (BLOCK,BLOCK) ONTO square :: board
!HPF$ ALIGN WITH board :: neighbours

      CHARACTER*(10) picfile

! INTERFACE block for update subroutine
!
      INTERFACE
        SUBROUTINE update_life(board, neighbours, iterations)
!HPF$ PROCESSORS, DIMENSION(2,2)   :: square
         INTEGER, DIMENSION(:,:)            :: board, neighbours
!HPF$ ALIGN (:,:) WITH *board(:,:) :: neighbours
!HPF$ DISTRIBUTE *(BLOCK,BLOCK) ONTO *square :: board
          INTEGER iterations
        END SUBROUTINE
      END INTERFACE

! Initialise board
!
      board = 0

      board(N/2,:) = 1
      board(:,N/2) = 1

! Print starting config to file life00.pgm
!
      WRITE(picfile, 20) 0
 20   FORMAT('life', i2.2, '.pgm')

      OPEN(UNIT=10, FILE=picfile)
      WRITE(10, FMT='(''P2'',/,i3,2x,i3,/,i3)') N, N, 1
      WRITE(10,*) board
      CLOSE(UNIT=10)

! Perform MAXLOOP updates
!
      CALL update_life(board, neighbours, MAXLOOP)

      END


      SUBROUTINE update_life(board, neighbours, iterations)
      IMPLICIT NONE

!HPF$ PROCESSORS, DIMENSION(2,2) :: square
      INTEGER, DIMENSION(:,:) :: board, neighbours
      INTEGER :: N
!HPF$ DISTRIBUTE *(BLOCK,BLOCK) ONTO *square :: board
!HPF$ ALIGN (:,:) WITH *board(:,:) :: neighbours
      INTEGER iterations, loop

      CHARACTER*(10) picfile
      N=SIZE(board,1)
      
      DO loop = 1, iterations

! Count number of neighbours
!
        neighbours =
     &    CSHIFT(board, SHIFT= 1, DIM=1) +
     &    CSHIFT(board, SHIFT=-1, DIM=1) +
     &    CSHIFT(board, SHIFT= 1, DIM=2) +
     &    CSHIFT(board, SHIFT=-1, DIM=2) +
     &    CSHIFT(CSHIFT(board, SHIFT= 1, DIM=2), SHIFT= 1, DIM=1) +
     &    CSHIFT(CSHIFT(board, SHIFT= 1, DIM=2), SHIFT=-1, DIM=1) +
     &    CSHIFT(CSHIFT(board, SHIFT=-1, DIM=2), SHIFT= 1, DIM=1) +
     &    CSHIFT(CSHIFT(board, SHIFT=-1, DIM=2), SHIFT=-1, DIM=1)

! Calculate new generation
!
        WHERE (neighbours.lt.2 .or. neighbours.gt.3)
          board = 0
        END WHERE
        WHERE (neighbours.eq.3)
          board = 1
        END WHERE

! Write out new state of board
!
        WRITE(picfile, 20) loop
 20     FORMAT('life', i2.2, '.pgm')
        OPEN(UNIT=10, FILE=picfile)
        WRITE(10, FMT='(''P2'',/,i3,2x,i3,/,i3)') N, N, 1
        WRITE(10,*) board
        CLOSE(UNIT=10)

      END DO

      END SUBROUTINE


next up previous contents
Next: Procedures Up: Life in a Procedure Previous: Life in a Procedure

©University of Liverpool, 1997
Thu May 29 10:11:26 BST 1997
Not for commercial use.