
!       PROGRAM MAIN
!       PARAMETER (N=100)
!       REAL X(N,N), Y(N,N)
! !HPF$ PROCESSORS P(4)
! !HPF$ TEMPLATE TX(200,200),TY(100,100)
! !HPF$ DISTRIBUTE TX(BLOCK,*) ONTO P
! !HPF$ DISTRIBUTE TY(BLOCK,*) ONTO P
! !HPF$ ALIGN X(i,j) WITH TX(2*i,2*j)
! !HPF$ ALIGN Y(i,j) WITH TY(i,j)
! 
!       FORALL (i=1:N,j=1:100) X(i,j) = 0
!       FORALL (i=1:100,j=1:N) Y(i,j) = i + j
! 
!       FORALL (i=26:50,j=26:50) X(i,j) = Y(i+1,j) + Y(i,j+1)
!       FORALL (i=1:100:2,j=1:N:2,X(i,j)/=0) X(i,j) = 1
! 
!       CALL FOO(X(1:100:2,1))
! 
!       PRINT *, (X(i,1),i=1,100,2)
!       END
! 
!       SUBROUTINE FOO(X)
!       REAL X(50)
! !HPF$ INHERIT X
!       REAL Y(50)
! !HPF$ PROCESSORS P(4)
! !HPF$ DISTRIBUTE Y(BLOCK) ONTO P
! 
!       FORALL (i=1:50) Y(i) = 2
!       FORALL (i=1:50) X(i) = Y(i) + 1
! 
!       RETURN
!       END

      PROGRAM main
        IMPLICIT NONE

        INCLUDE 'pcrc.inc'

        INTEGER shp_p(1)
        INTEGER grd_p
  
        INTEGER rng_tx1, rng_tx2, rng_ty1, rng_ty2
  
        REAL x(25, 100), y(25, 100)
  
        INTEGER dad_x, dad_y

        INTEGER dad_ys, dad_xs

        INTEGER dad_tmp1, dad_tmp2
  
        INTEGER i, j, ll1, lu1, ls1, ll2, lu2, ls2
  
        CALL pcrc_init()

! Define processor arrangement

        shp_p(1) = 4
        CALL grid_init(1, shp_p, grd_p)
       
! Define templates

        rng_tx1 = new_range_distribute(1, 200, grd_p, 1, 1)
        rng_tx2 = new_range_collapse(1, 200)
  
        rng_ty1 = new_range_distribute(1, 100, grd_p, 1, 1)
        rng_ty2 = new_range_collapse(1, 100)
  
! Define main arrays

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

        CALL loop_bounds(rng(dad_x, 1), ll1, lu1, ls1)
        CALL loop_bounds(rng(dad_x, 2), ll2, lu2, ls2)
        DO i = ll1, lu1, ls1
	  DO j = ll2, lu2, ls2
	    x(i, j) = 0
	  END
        END
  
! Do parallel loop  y(i, j) = i + j

        CALL loop_bounds(rng(dad_y, 1), ll1, lu1, ls1)
        CALL loop_bounds(rng(dad_y, 2), ll2, lu2, ls2)
        DO i = ll1, lu1, ls1
	  DO j = ll2, lu2, ls2
	    y(i, j) = local_to_global(rng(dad_y, 1), i) +                &
     &                local_to_global(rng(dad_y, 2), j)
	  END
        END
  
        rng_i = new_range_align(1, 25, rng(dad_x, 1), 26, 50, 1)
        rng_j = new_range_align(1, 25, rng(dad_x, 2), 26, 50, 1)

! Define and write temporary for remapped y(i + 1, j)

        dad_tmp1 = new_array_data(tmp1, 2, 4, 1, 1, grp_p)
        CALL set_array_range_copy(dad_tmp1, 1, rng_i)
        CALL set_array_range_copy(dad_tmp1, 2, rng_j)
        CALL set_array_data_done(dad_tmp1)
  
        dad_ys = new_array_section(dad_y)
        CALL set_array_triplet(dad_ys, 1, dad_y, 1, 27, 51, 1)
        CALL set_array_triplet(dad_ys, 2, dad_y, 2, 26, 50, 1)
        CALL set_array_section_done(dad_ys)
  
        CALL remap(dad_tmp1, dad_ys)
  
        CALL delete(dad_ys)

! Define and write temporary for remapped y(i, j + 1)

        dad_tmp2 = new_array_data(tmp2, 2, 4, 1, 1, grp_p)
        CALL set_range_copy(rng(dad_tmp2, 1), rng_i)
        CALL set_range_copy(rng(dad_tmp2, 1), rng_j)
        CALL set_array_data_done(dad_tmp2)
  
        dad_ys = new_array_section(dad_y)
        CALL set_array_triplet(dad_ys, 1, dad_y, 1, 27, 51, 1)
        CALL set_array_triplet(dad_ys, 2, dad_y, 2, 26, 50, 1)
        CALL set_array_section_done(dad_ys)
  
        CALL remap(dad_tmp2, dad_ys)
  
        CALL delete(dad_ys)

! Do parallel loop  x(i, j) = y(i + 1, j) + y(i, j + 1)

        CALL loop_bounds(rng_i, ll1, lu1, ls1)
        CALL loop_bounds(rng_j, ll2, lu2, ls2)
        DO i = ll1, lu1, ls1
	  DO j = ll2, lu2, ls2
	    x(i, j) = tmp1(i, j) + tmp2(i, j)
	  END
        END

        CALL delete_range(rng_i)
        CALL delete_range(rng_i)

! Do parallel loop  x(i, j) = 1

        rng_i = new_range_align(1, 50, rng(dad_x, 1), 1, 100, 2)
        rng_j = new_range_align(1, 50, rng(dad_x, 2), 1, 100, 2)

        CALL loop_bounds(rng_i, ll1, lu1, ls1)
        CALL loop_bounds(rng_j, ll2, lu2, ls2)
        DO i = ll1, lu1, ls1
	  DO j = ll2, lu2, ls2
            IF(x(i, j) .NE. 0) x(i, j) = 1
	  END
        END

        CALL delete_range(rng_i)
        CALL delete_range(rng_i)

        CALL delete_array(tmp2)
        CALL delete_array(tmp1)

! Define arguments and make call to `foo'

        dad_xs = new_array_section(dad_xs, dad_x)
        CALL set_array_triplet(dad_xs, 1, dad_x, 1, 1, 100, 2)
        CALL set_array_scalar(dad_xs, dad_x, 2, 1)
        CALL set_array_section_done(dad_xs)
        
        CALL foo(x(1, 1), dad_xs)
        
        CALL delete(dad_xs)

!      PRINT *, (X(i,1),i=1,100,2)

        CALL delete_array(dad_y)
        CALL delete_array(dad_x)

        CALL delete_range(rng_ty1)
        CALL delete_range(rng_tx1)

        CALL pcrc_finalize()
      END


      SUBROUTINE foo(x, dad_x)
        IMPLICIT NONE

        REAL x(*)
        INTEGER dad_x

        INCLUDE 'pcrc.inc'

        INTEGER shp_p(1)
        INTEGER grd_p
  
        REAL y(13)
        INTEGER dad_y

        INTEGER dad_tmp1

        CALL reset_range_lb(rng(dad_x, 1), 1)

! Define processor arrangement

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

! Define main arrays

        dad_y = new_array_data(y, 2, 4, 2, 1, grp_p)
        CALL set_array_range_distribute(dad_y, 1, 1, 50, grd_p, 1, 1)
        CALL set_array_data_done(dad_y)
       
! Do parallel loop  y(i) = 2

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

        dad_tmp1 = new_array_data(null, 2, 4, 1, 1, prc(dad_x))
        CALL set_array_range_copy(dad_tmp1, 1, rng(dad_x, 1))
        CALL set_array_data_done(dad_tmp1)
        
        bas_tmp1 = reset_array_alloc(dad_tmp1)

        CALL remap(dad_tmp1, dad_y)

! Do parallel loop  x(i) = y(i) + 1

        str_x_1  = str(dad_x, 1)
        
        CALL loop_bounds(rng(dad_x, 1), ll, lu, ls)
        DO i = ll, lu, ls
          x(1 + (i - 1) * str_x_1) = real_stack(bas_tmp1 + i - 1) + 1
        END DO

        CALL reset_array_free(dad_tmp1)
        CALL delete_array(dad_tmp1)

        CALL delete_array(dad_y)
      END

