program ex

  use gabriel
  use MPI
  implicit none

  integer,parameter :: n=10
  integer,parameter :: s=2

  real,dimension(:,:,:),allocatable :: a,b
  integer ierr,rank,right,left,mpisize,i,j,k
  integer hor,ver

  type(distribution) :: d
  call MPI_Init(ierr)
  call MPI_Comm_rank(MPI_COMM_WORLD,rank,ierr)
  call MPI_Comm_size(MPI_COMM_WORLD,mpisize,ierr)
  right=rank+1
  left=rank-1
  if (right.ge.mpisize)right=0
  if (left.lt.0)left=mpisize-1
  print*,'left,rank,right=',left,rank,right

  hor=mod(rank,2)
  ver=rank/2
  allocate(a(hor*s-1:hor*s+s,ver*s:ver*s+s+1,0:7))
  a=rank
  do i=lbound(a,1),ubound(a,1)
  do j=lbound(a,2),ubound(a,2)
  do k=lbound(a,3),ubound(a,3)
    a(i,j,k)=a(i,j,k)+i*0.1+j*0.01+k*0.001
  enddo
  enddo
  enddo

  write(*,'(a,4i3)')'Size,Rank,hor,ver=',mpisize,rank,hor,ver

  write(*,'(a,i3,a,i4,4f13.3,2i5)')'BEFORE Rank',rank,' data=',ver*s,a(:,ver*s,1),lbound(a,1),ubound(a,1)
  write(*,'(a,i3,a,i4,4f13.3,2i5)')'BEFORE Rank',rank,' data=',ver*s+1,a(:,ver*s+1,1),lbound(a,1),ubound(a,1)
  write(*,'(a,i3,a,i4,4f13.3,2i5)')'BEFORE Rank',rank,' data=',ver*s+2,a(:,ver*s+2,1),lbound(a,1),ubound(a,1)
  write(*,'(a,i3,a,i4,4f13.3,2i5)')'BEFORE Rank',rank,' data=',ver*s+3,a(:,ver*s+3,1),lbound(a,1),ubound(a,1)

  call gabriel_init
  call d%autocreate(a,(/hor*s,ver*s+1,1/),(/hor*s+s-1,ver*s+s,6/),MPI_COMM_WORLD,periodic=(/.true.,.true.,.true./))
!  call d%autocreate(a,(/hor*s,ver*s+1,1/),(/hor*s+s-1,ver*s+s,6/),MPI_COMM_WORLD,periodic=(/.true.,.false.,.false./))

  print*,'Update decomposition..'
  call d%update(a,a)

  write(*,'(a,i3,a,i4,4f13.3)')' AFTER Rank',rank,' data=',ver*s,a(:,ver*s,1)
  write(*,'(a,i3,a,i4,4f13.3)')' AFTER Rank',rank,' data=',ver*s+1,a(:,ver*s+1,1)
  write(*,'(a,i3,a,i4,4f13.3)')' AFTER Rank',rank,' data=',ver*s+2,a(:,ver*s+2,1)
  write(*,'(a,i3,a,i4,4f13.3)')' AFTER Rank',rank,' data=',ver*s+3,a(:,ver*s+3,1)
  deallocate(a)

  call MPI_Finalize(ierr)

end


      PROGRAM MAINA

      INTEGER N, NMAX, JMAX, IL, IU, TRYRAC, M, LDZ, ZERO
      PARAMETER (NMAX=1000, JMAX=NMAX, LDZ=NMAX, ZERO=0)

      DOUBLE PRECISION VL, VU, D(NMAX), E(NMAX), W(NMAX),
     $                 Z(NMAX,JMAX), ZSUPP(2*NMAX)

      INTEGER I, J, UFILE, IERR
      PARAMETER (UFILE=1)

*     external functions
      EXTERNAL MRRR

*     Read in data
      OPEN(UFILE, FILE='Wilkinson21.data', STATUS='OLD', IOSTAT=IERR,
     $     FORM='FORMATTED')

      READ(UFILE, 10) N
      DO 100, I=1,N
         READ(UFILE, 20, END=200) D(I), E(I)
 100  CONTINUE
 200  CONTINUE

      CLOSE(UFILE)

*     Call MRRR ( if underscores not added automatically MRRR_() )
      TRYRAC = 1

      CALL MRRR('V', 'A', N, D, E, VL, VU, IL, IU, TRYRAC,
     $          M, W, Z, LDZ, ZSUPP, IERR)
      IF (IERR .NE. 0) THEN
         WRITE(*,*) 'Routine has failed with error', IERR
      ENDIF

*     Write out results; this is just a hack and will sometimes fail
*     since the output different processes may interleave
      OPEN(UFILE, FILE='result_all.m', STATUS='UNKNOWN')
      CLOSE(UFILE)

      OPEN(UFILE, FILE='result_all.m', STATUS='OLD',
     $     ACCESS='APPEND')
      CALL PRTVEC(UFILE, 'W', W, M, ZERO)

      OPEN(UFILE, FILE='result_all.m', STATUS='OLD',
     $     ACCESS='APPEND')
      DO 500, J=1,M
         CALL PRTCOL(UFILE, 'Z', Z(1,J), N, J, ZERO)
 500  CONTINUE
      CLOSE(UFILE)

 10   FORMAT(1X, I4)
 20   FORMAT(1X, E23.17, 1X, E23.17E2)

      END

      SUBROUTINE PRTVEC(UFILE, NAME, V, N, OFFSET)

      CHARACTER NAME
      INTEGER I, N, OFFSET, UFILE
      DOUBLE PRECISION V(N)

      DO 100, I=1,N
         WRITE(UFILE,10) NAME,'(',I+OFFSET,')=',V(I),';'
 100  CONTINUE

 10   FORMAT(1X, A1, A1, I4, A2, 1X, E25.17E3, A1)

      END

      SUBROUTINE PRTCOL(UFILE, NAME, V, N, COL, OFFSET)

      CHARACTER NAME
      INTEGER I, N, COL, OFFSET, UFILE
      DOUBLE PRECISION V(N)

      DO 100, I=1,N
         WRITE(UFILE,10) NAME,'(',I,',',COL+OFFSET,')=',V(I),';'
 100  CONTINUE

 10   FORMAT(1X, A1, A1, I4, A1, I4, A2, 1X, E25.17E3, A1)

      END