(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