      program DISTRDERIVED1
!    Testing DISTRIBUTE and REDISTRIBUTE directives
!            INDIRECT, DERIVED  distributions (format with range)
	print *,'=== START OF distrderived1 ========================'
      call distrderived11
 1    print *,'=== END OF distrderived1 ========================= '    

      end
      subroutine distrderived11
      parameter (L=10, ER=100000)
      integer:: x_t, y_t, z_t, cur, erri = ER
      integer, allocatable :: A(:), B(:), AS(:), BS(:)
      integer, allocatable :: ibstart(:), ibend(:), ib(:)
      integer, allocatable :: indir_x(:), indir_y(:), indir_z(:)
      integer MAP(L*L*L)
      character*14:: tname="distrderived11"
!DVM$ TEMPLATE E(L*L*L)
!DVM$ TEMPLATE :: E2(:)
!DVM$ DISTRIBUTE :: E
!DVM$ DISTRIBUTE :: E2
!DVM$ ALIGN :: A,B
!DVM$ ALIGN :: indir_x, indir_y,indir_z, ibstart, ibend
!DVM$ ALIGN :: ib
     
      allocate(AS(L*L*L),BS(L*L*L))
      call  distrderived11_s(AS,BS)
      call fillMap(map,L,1)
      allocate(A(L*L*L),B(L*L*L), ibstart(L*L*L), ibend(L*L*L))
      allocate(indir_x(L*L*L), indir_y(L*L*L), indir_z(L*L*L))
!DVM$ REDISTRIBUTE E(INDIRECT(map))
!DVM$ REALIGN (I) WITH E(I) :: A,B,indir_x, indir_y,indir_z
!DVM$ REALIGN (I) WITH E(I) :: ibstart, ibend
      cur = 1
      do i = 1,L*L*L
        x_t = (i-1) / (L*L)
        y_t = mod((i-1) / L, L)
        z_t = mod(i-1, L)
        indir_x(i) = x_t
        indir_y(i) = y_t
        indir_z(i) = z_t
        ibstart(i) = cur
        if (x_t.gt.0) cur = cur + 1
        if (x_t.lt.L-1) cur = cur + 1
        if (y_t.gt.0) cur = cur + 1
        if (y_t.lt.L-1) cur = cur + 1
        if (z_t.gt.0) cur = cur + 1
        if (z_t.lt.L-1) cur = cur + 1
        ibend(i) = cur - 1
      enddo
      allocate(ib(cur-1))
!DVM$ TEMPLATE_CREATE(E2(cur-1))
!DVM$ REDISTRIBUTE E2(DERIVED((ibstart(i):ibend(i)) with E(@i)))
!DVM$ REALIGN (I) WITH E2(I) :: ib

      cur = 1
      do i = 1,L*L*L
        x_t = (i-1) / (L*L)
        y_t = mod((i-1) / L, L)
        z_t = mod(i-1, L)
        if (x_t.gt.0) then
          ib(cur) = i - (L*L)
          cur = cur + 1
        endif
        if (x_t.lt.L-1) then
          ib(cur) = i+(L*L)
          cur = cur + 1
        endif
        if (y_t.gt.0) then
          ib(cur) = i-L
          cur = cur + 1
        endif
        if (y_t.lt.L-1) then
          ib(cur) = i+L
          cur = cur + 1
        endif
        if (z_t.gt.0) then
          ib(cur) = i-1
          cur = cur + 1
        endif
        if (z_t.lt.L-1) then
          ib(cur) = i+1
          cur = cur + 1
        endif
      enddo

!DVM$ LOCALIZE(ibstart => ib(:))
!DVM$ LOCALIZE(ibend => ib(:))
!DVM$ SHADOW_ADD(E((ib(ibstart(i):ibend(i))) with E(@i)) = "nei1")
!DVM$&  include_to A
!DVM$ LOCALIZE(ib => A(:))
!DVM$ REGION
!DVM$ PARALLEL (i) ON B(i)
      do i = 1, L*L*L
         if (indir_x(i) == 0 .or. indir_x(i) == L-1 .or.    
     &       indir_y(i) == 0 .or. indir_y(i) == L-1 .or.    
     &       indir_z(i) == 0 .or. indir_z(i) == L-1) then
           A(i) = 0
         else
           A(i) = 4 + indir_x(i) + indir_y(i) + indir_z(i)
         endif
      enddo
!DVM$ PARALLEL (i) ON B(i), SHADOW_RENEW(A)
        do i = 1, L*L*L
          if (indir_x(i) /= 0 .and. indir_x(i) /= L-1 .and.    
     &        indir_y(i) /= 0 .and. indir_y(i) /= L-1 .and.    
     &        indir_z(i) /= 0 .and. indir_z(i) /= L-1) then
            B(i) = (A(ib(ibstart(i)))   + A(ib(ibstart(i)+1))  
     &            + A(ib(ibstart(i)+2)) + A(ib(ibstart(i)+3))  
     &            + A(ib(ibstart(i)+4)) + A(ib(ibstart(i)+5)))/ 6.0
          endif
        enddo
!DVM$ PARALLEL (i) ON B(i), REDUCTION(min(erri))
        do i = 1, L*L*L
          if (indir_x(i) /= 0 .and. indir_x(i) /= L-1 .and.    
     &        indir_y(i) /= 0 .and. indir_y(i) /= L-1 .and.    
     &        indir_z(i) /= 0 .and. indir_z(i) /= L-1) then
            if(B(i) .ne. BS(i)) erri =  min(erri, ABS(B(i)-BS(i)))
          endif
        enddo
!DVM$ END REGION
!DVM$ GET_ACTUAL(erri)
      if (erri .eq. ER) then     
          call ansyes(tname)
      else
          call ansno(tname)
      endif
      deallocate(ibstart,ibend)
      deallocate(ib)
      deallocate(A,B,indir_x,indir_y,indir_z)
      end
!-------------------------------------------------------------
      subroutine fillMap(map,L,axis)
      integer numproc
      integer i,L,axis
      integer map(L*L*L)
      PROCESSORS_SIZE(axis) = 1
      numproc = PROCESSORS_SIZE(axis)
      do i = 1,L*L*L
        map(i) = ((i-1) * numproc) / (L*L*L)
      enddo
      end
!---------------------------------------------------------------
      subroutine distrderived11_s(A,B)
      parameter (L=10)
      integer x_t, y_t, z_t, cur
      integer:: A(L*L*L), B(L*L*L)
      integer, allocatable :: ibstart(:), ibend(:), ib(:)
      integer, allocatable :: indir_x(:), indir_y(:),indir_z(:)
      allocate(ibstart(L*L*L), ibend(L*L*L))
      allocate(indir_x(L*L*L), indir_y(L*L*L), indir_z(L*L*L))
      cur = 1
      do i = 1,L*L*L
	x_t = (i-1) / (L*L)
	y_t = mod((i-1) / L, L)
	z_t = mod(i-1, L)
	indir_x(i) = x_t
	indir_y(i) = y_t
	indir_z(i) = z_t
	ibstart(i) = cur
	if (x_t.gt.0) cur = cur + 1
	if (x_t.lt.L-1) cur = cur + 1
	if (y_t.gt.0) cur = cur + 1
	if (y_t.lt.L-1) cur = cur + 1
	if (z_t.gt.0) cur = cur + 1
	if (z_t.lt.L-1) cur = cur + 1
	ibend(i) = cur - 1
      enddo
      allocate(ib(cur-1))
      cur = 1
      do i = 1,L*L*L
	x_t = (i-1) / (L*L)
	y_t = mod((i-1) / L, L)
	z_t = mod(i-1, L)
	if (x_t.gt.0) then
	ib(cur) = i - (L*L)
	cur = cur + 1
	endif
	if (x_t.lt.L-1) then
	ib(cur) = i+(L*L)
	cur = cur + 1
	endif
	if (y_t.gt.0) then
	ib(cur) = i-L
	cur = cur + 1
	endif
	if (y_t.lt.L-1) then
	ib(cur) = i+L
	cur = cur + 1
	endif
	if (z_t.gt.0) then
	ib(cur) = i-1
	cur = cur + 1
	endif
	if (z_t.lt.L-1) then
	ib(cur) = i+1
	cur = cur + 1
	endif
      enddo

      do i = 1, L*L*L	
	if (indir_x(i) == 0 .or. indir_x(i) == L-1 .or.  
     & indir_y(i) == 0 .or. indir_y(i) == L-1 .or.    
     & indir_z(i) == 0 .or. indir_z(i) == L-1) then
	A(i) = 0
	else
	A(i) = 4 + indir_x(i) + indir_y(i) + indir_z(i)
	endif
      enddo

      do i = 1, L*L*L
	if (indir_x(i) /= 0 .and. indir_x(i) /= L-1 .and. 
     & indir_y(i) /= 0 .and. indir_y(i) /= L-1 .and.   
     & indir_z(i) /= 0 .and. indir_z(i) /= L-1) then

	B(i) = (A(ib(ibstart(i)))   + A(ib(ibstart(i)+1))    
     &        + A(ib(ibstart(i)+2)) + A(ib(ibstart(i)+3))    
     &        + A(ib(ibstart(i)+4)) + A(ib(ibstart(i)+5)))/ 6.0
	endif
      enddo
      deallocate(ibstart,ibend)
      deallocate(ib)
      deallocate(indir_x,indir_y,indir_z)
      end 

C -------------------------------------------------
      subroutine ansyes(name)
      character*14 name
      print *,name,'  -  complete'
      end
      subroutine ansno(name)
      character*9 name
      print *,name,'  -  ***error'
      end


     
