PROGRAM GameOfLife
! 2D cellular automaton ("Game of Life")
! (c) Pekka Manninen, Jussi Enkovaara, CSC - IT Center for Science Ltd
! based on the code presented in Haataja et al., Rinnakkaislaskentaa MPI:lla 
! (CSC 1997)
  IMPLICIT NONE
  INCLUDE 'mpif.h'
  INTEGER, SAVE :: ntask, & ! number of MPI tasks
       my_id, &             ! MPI rank of the task
       rc                   ! return code
  INTEGER, PARAMETER :: &
      max_iter = 1000, & ! maximum number of iterations
      max_width = 1000, & ! max board width
      max_height = 1000, & ! max board height
      print_id = 0, &      ! which MPI rank does i/o
      board_tag_1 = 50, & ! tags for column data communication
      board_tag_2 = 51, & 
      freq = 10           ! after how many iterations we print the board
  INTEGER, DIMENSION(:,:), POINTER :: &
      board_1, board_2     ! boards
  INTEGER :: &
      height, width, &     ! board dimensions
      iter, &              
      i                    
  REAL(KIND=8) :: t0, t ! MPI wall times

  ! initialize MPI
  CALL init_comm(ntask, my_id)
  ! read in the initial configuration
  CALL read_data(iter, height, width, ntask, my_id)
  ! initialize boards
  t0 = MPI_Wtime()
  CALL init_board(board_1, board_2, height, width, my_id)
  ! develop the automaton
  DO i = 1, iter
    CALL MPI_BARRIER(MPI_COMM_WORLD, rc)
    CALL iterate(board_1, board_2, ntask, my_id, height)
    IF (MOD(i,freq)==0) CALL draw(board_1, i, my_id)
  END DO
  t = MPI_Wtime() - t0
  IF (my_id == print_id) THEN
    WRITE(*,'(A,I4,A,F6.2,A)') 'Completed ', iter, ' iterations in ', t, &
       ' seconds.'
  END IF
  CALL end_run()

CONTAINS

  SUBROUTINE init_comm(ntask, id)
    IMPLICIT NONE
    INTEGER,  INTENT(OUT) :: ntask, id
    INTEGER :: rc
    ! initialize MPI and request the rank id and the total number of
    ! ranks here
    CALL MPI_INIT(rc)
!    CALL MPI_COMM_....
!    CALL MPI_...
  END SUBROUTINE init_comm

  SUBROUTINE read_data(iter, height, width, ntask, id)
    IMPLICIT NONE
    INTEGER, INTENT(OUT) :: iter, height, width
    INTEGER, INTENT(IN) :: id, ntask
    INTEGER, DIMENSION(0:ntask-1) :: num
    INTEGER :: task_cols, col_mod, i, rc
    IF (id == print_id) THEN
       WRITE (*,*) 'Insert the number of iterations'
       READ(*,*) iter
       IF (iter < 1 .OR. iter > max_iter) iter = max_iter
       WRITE (*,*) 'Insert the size of the board (height width)'
       READ(*,*) height, width
       IF (height < 1 .OR. height > max_height) height = max_height
       IF (width < 1 .OR. width > max_width) width = max_width
       ! determine the number of columns in each task
       task_cols = width/ntask
       col_mod = MOD(width,ntask)
       DO i = 0, ntask-1
          IF (i < col_mod) THEN
             num(i) = task_cols + 1
          ELSE
             num(i) = task_cols
          END IF
       END DO
    END IF
    ! Broadcast the user input (iter, height, and the number of columns) 
    ! to all the tasks here
    !CALL MPI_...
    !CALL ...
    !CALL ...
  END SUBROUTINE read_data
  
  SUBROUTINE init_board(board_1, board_2, height, width, &
       id)
    IMPLICIT NONE
    INTEGER, DIMENSION(:,:), POINTER :: board_1, board_2
    INTEGER, INTENT(IN) :: height, width, id
    INTEGER :: i, stride, rc, ios
    ALLOCATE(board_1(1:height,0:width+1), &
         board_2(1:height,0:width+1))
    board_1(:,:) = 0
    board_2(:,:) = 0
    board_1(height/(id+2),:) = 1
    board_1(:,width/(id+2)) = 1
    CALL draw(board_1, 0, id)
  END SUBROUTINE init_board

  SUBROUTINE iterate(board_1, board_2, ntask, id, height)
    IMPLICIT NONE
    INTEGER, PARAMETER :: ALIVE = 1, DEAD = 0
    INTEGER, DIMENSION(:,:), POINTER :: board_1, board_2
    INTEGER, INTENT(IN) :: ntask, id, height
    INTEGER, DIMENSION(:,:), POINTER :: temp_board
    INTEGER, DIMENSION(mpi_status_size) :: status
    INTEGER :: hl,hu,wl, wu, rc,left_ngbr,right_ngbr
    INTEGER :: ip,im
    INTEGER :: i,j,sum

    hl = LBOUND(board_1,1)
    hu = UBOUND(board_1,1)
    wl = LBOUND(board_1,2)
    wu = UBOUND(board_1,2)

    ! communicate the boundaries in a chain-like exchange
    ! remember that the board is periodic, i.e. the rank 0 
    ! should exchange its leftmost board column with the
    ! rank n-1
    !
    ! hint: use either sends & recvs or a shortcut with mpi_sendrecv
    ! CALL ...


    ! determine whether the cell is dead or alive in the
    ! next iteration
    DO i=hl,hu
      !take periodic boundary conditions into account
      ip=i+1
      im=i-1
      IF(i==hl)  im=hu
      IF(i==hu)  ip=hl
      DO j=wl+1,wu-1
      ! determine the number of alive neighbor cells§
        sum=board_1(im,j-1)+board_1(i,j-1)+board_1(ip,j-1)+ &
            board_1(im,j)+board_1(ip,j)+ &
            board_1(im,j+1)+board_1(i,j+1)+board_1(ip,j+1);
        ! set the status of a cell in the next iteration
        IF(sum< 2 .OR. sum> 3) THEN
          board_2(i,j)=DEAD
        ELSE IF (sum==3) THEN
          board_2(i,j)=ALIVE
        ELSE
          board_2(i,j)=board_1(i,j)
        END IF
      END DO
    END DO
    temp_board => board_1
    board_1 => board_2
    board_2 => temp_board
  END SUBROUTINE iterate

  
  SUBROUTINE draw(board_1, iter, id)
    IMPLICIT NONE
    INTEGER, DIMENSION(:,:), POINTER :: board_1
    INTEGER, INTENT(IN) :: iter, id
    CHARACTER(LEN=15) :: filename, cnt, rank
    INTEGER :: i, w, h, ios, print_unit

    h = SIZE(board_1,1)
    w = SIZE(board_1,2)
    WRITE(cnt,'(I8)') iter
    WRITE(rank,'(I3)') id
    ! all the tasks print out their own board
    WRITE(filename,'(A)')  'life_' // TRIM(ADJUSTL(cnt)) // &
         '_' // TRIM(ADJUSTL(rank)) // '.pbm'
    print_unit = (id+1)*10
    OPEN(print_unit, file=filename, status='replace', &
        action='write', iostat=ios)
    WRITE(print_unit,'(A)') 'P1'
    WRITE(print_unit,'(A,I4)') '# Iteration number ', iter
    WRITE(print_unit,'(2I4)') w-2, h
    DO i = 1, h
      WRITE(print_unit,'(1000I2)') board_1(i,1:w-2)
    END DO
    CLOSE(print_unit, status='keep', iostat=ios)
  END SUBROUTINE draw
  
  SUBROUTINE end_run()
    ! Clean program shutdown
    IMPLICIT NONE
    INTEGER :: rc
    ! Finalize MPI
    CALL MPI_FINALIZE(rc)
  END SUBROUTINE end_run
  

END PROGRAM GameOfLife