
!       PROGRAM MAIN
!       REAL X(2:99), Y(100)
! !HPF$ PROCESSORS P(4)
! !HPF$ TEMPLATE TX(400),TY(-200:199)
! !HPF$ DISTRIBUTE TX(BLOCK) ONTO P
! !HPF$ DISTRIBUTE TY(BLOCK) ONTO P
! !HPF$ ALIGN X(i) WITH TX(2*i+1)
! !HPF$ ALIGN Y(i) WITH TY(3*i-50)
! 
!       FORALL (i=2:99) X(i) = 0
!       FORALL (i=1:100) Y(i) = i
! 
!       FORALL (i=2:99) X(i) = Y(i+1) + Y(i-1)
! 
!       PRINT *, (X(i),i=2,99)       
!       END

      PROGRAM main
        IMPLICIT NONE

        INCLUDE 'pcrc.inc'

        INTEGER shp_p(1)
        INTEGER grd_p
  
        INTEGER rng_tx1, rng_ty1
  
        REAL x(100), y(100)
        REAL tmp1(100), tmp2(100), tmp3(100), tmp4(100)
  
        INTEGER dad_x, dad_y
        INTEGER dad_tmp1, dad_tmp2, dad_tmp3, dad_tmp4
        INTEGER dad_ys
  
        INTEGER i, ll, lu, ls, amount1, amount2, status1, status2
        INTEGER i1, i2
        REAL u1, v1, u2, v2
  
        CALL pcrc_init()

! Define processor arrangement

        shp_p(1) = 4
        CALL grid_init(1, shp_p, grd_p)

! Define template

        rng_tx1 = new_range_distribute(1, 440, grd_p, 1, 1)
        rng_ty1 = new_range_distribute(-200, 199, grd_p, 1, 1)
  
! Define main arrays

        dad_x = new_array_data(x, 2, 4, 1, 1, grd_p)
        CALL set_array_range_align(dad_x, 1, 2, 99, rng_tx1, 1, 2)
        CALL set_array_data_done(dad_x)
       
        dad_y = new_array_data(y, 2, 4, 1, 1, grd_p)
        CALL set_array_range_align(dad_y, 1, 1, 100, rng_ty1, 1, 2)
        CALL set_array_data_done(dad_y)
       
! Do parallel loop x(i) = 0

        CALL loop_bounds(rng(dad_x, 1), ll, lu, ls)
        DO i = ll, lu, ls
          x (i) = 0
        END DO
  
! Do parallel loop y(i) = i

        CALL loop_bounds(rng(dad_y, 1), ll, lu, ls)
        DO i = ll, lu, ls
          y (i) = local_to_global(rng(dad_y, 1), i)
        END DO
  
! Define and write temporary for remapped y(i + 1)

        amount1 = detect_communication(dad_x, dad_y, 1, 2, 99, 1, 1, 1,   &
     &                                 u1, v1, status1)
  
        IF(status1 .EQ. 1) THEN
          dad_tmp1 = new_array_data(tmp1, 2, 4, 1, 1, grd_p)
          CALL set_array_range_copy(dad_tmp1, 1, rng(dad_y, 1))
          CALL set_array_data_done(dad_tmp1)
  
          CALL shift(dad_tmp1, dad_y, amount1)
        ELSE IF(status1 .EQ. 2) THEN
          dad_tmp3 = new_array_data(tmp3, 2, 4, 1, 1, grd_p)
          CALL set_array_range_copy(dad_tmp3, 1, rng(dad_x, 1))
          CALL set_array_data_done(dad_tmp3)
  
          dad_ys = new_array_section(dad_y)
          CALL set_array_triplet(dad_ys, 1, dad_y, 1, 3, 100, 1)
          CALL set_array_section_done(dad_ys)
  
          CALL remap(dad_tmp3, dad_ys)

          CALL delete_array(dad_ys)
        END IF
  
! Define and write temporary for remapped y(i - 1)

        amount2 = detect_communication(dad_x, dad_y, 1, 2, 99, 1, 1, -1,  &
     &                                 u2, v2, status2)
  
        IF(status2 .EQ. 1) THEN
          dad_tmp2 = new_array_data(tmp2, 2, 4, 1, 1, grd_p)
          CALL set_array_range_copy(dad_tmp2, 1, rng(dad_y, 1))
          CALL set_array_data_done(dad_tmp2)
  
          CALL shift(dad_tmp2, dad_y, amount2)
        ELSE IF(status2 .EQ. 2) THEN
          dad_tmp4 = new_array_data(tmp4, 2, 4, 1, 1, grd_p)
          CALL set_array_range_copy(dad_tmp4, 1, rng(dad_x, 1))
          CALL set_array_data_done(dad_tmp4)
  
          dad_ys = new_array_section(dad_y)
          CALL set_array_triplet(dad_ys, 1, dad_y, 1, 1, 98, 1)
          CALL set_array_section_done(dad_ys)
  
          CALL remap(dad_tmp4, dad_ys)

          CALL delete_array(dad_ys)
        END IF
  
! Do parallel loop  y(i) = y(i+1) + y(i-1)

        CALL loop_bounds(rng(dad_x, 1), ll, lu, ls)
        DO i = ll, lu, ls
          i1 = NINT(u1 * i + v1)
          i2 = NINT(u2 * i + v2)
  
          IF(status1 .EQ. 0 .AND. status2 .EQ. 0) THEN
            x(i) = y(i1) + y(i2)
          ELSE IF(status1 .EQ. 0 .AND. status2 .EQ. 1) THEN
            x(i) = y(i1) + tmp2(i2)
          ELSE IF(status1 .EQ. 0 .AND. status2 .EQ. 2) THEN
            x(i) = y(i1) + tmp4(i2)
          ELSE IF(status1 .EQ. 1 .AND. status2 .EQ. 0) THEN
            x(i) = tmp1(i1) + y(i2)
          ELSE IF(status1 .EQ. 1 .AND. status2 .EQ. 1) THEN
            x(i) = tmp1(i1) + tmp2(i2)
          ELSE IF(status1 .EQ. 1 .AND. status2 .EQ. 2) THEN
            x(i) = tmp1(i1) + tmp4(i2)
          ELSE IF(status1 .EQ. 2 .AND. status2 .EQ. 0) THEN
            x(i) = tmp3(i1) + y(i2)
          ELSE IF(status1 .EQ. 2 .AND. status2 .EQ. 1) THEN
            x(i) = tmp3(i1) + tmp2(i2)
          ELSE
            x(i) = tmp3(i1) + tmp4(i2)
          END IF
        END DO
  
        IF(status1 .EQ. 1) THEN
          CALL delete_array(dad_tmp1)
        ELSE IF(status1 .EQ. 2) THEN
          CALL delete_array(dad_tmp3)
        END IF
  
        IF(status2 .EQ. 1) THEN
          CALL delete_array(dad_tmp2)
        ELSE IF(status1 .EQ. 2) THEN
          CALL delete_array(dad_tmp4)
        END IF
  
! Reclaim memory

        CALL delete_array(dad_y)
        CALL delete_array(dad_x)

        CALL delete_range(rng_ty1)
        CALL delete_range(rng_tx1)

        CALL pcrc_finalize()
      END

