
c             program decimate
c  sample grid at multiples of the interval

	dimension  r(4000),r2(2001)
	character  ifile*56, ofile*56
	character  id*56, p*8
	data       nmax/4000/, isw/13/, jsw/14/
	ifile=' '
	ofile=' '

	write(*,'(1x,a,$)') 'ifile :'
	read(*,1) ifile
1	format( a )
	open( unit=isw, file=ifile, status='old',
     1 form='unformatted', share='denywr' )

	read( isw ) id, p, nc, nr, nz, xo, dx, yo, dy
	write(*,11)id,nc,nr,dx,dy
11	format(1x,a56,/,' size ',2i5,'  dx-dy ',2e15.4)

	if ( nc .gt. nmax ) then
	  write(*,*) 'maximum number of column =', nmax
	  stop
	endif

	write(*,'(a,$)') ' ofile :'
	read(*,1) ofile

22	write(*,'(a,$)') ' enter decimation factor ( integer > 1 )'
	read(*,*) iskip
	if ( iskip .le. 1 ) go to 22

	k   = iskip - 1
	nc2 = 1 + ( nc - 1 ) / iskip 
	nr2 = 1 + ( nr - 1 ) / iskip
	write(*,3) nc2, nr2
3	format(' new grid is ',i4,' X ',i4)

	length = nc2 + 1
	if ( length .lt. 30 ) length = 30
	open( unit=jsw, file=ofile, status='unknown', form='unformatted')
c	1     recl=length, recordtype='fixed' )

	dx2 = dx * float( iskip )
	dy2 = dy * float( iskip )
	write(jsw) id, p, nc2, nr2, nz, xo, dx2, yo, dy2

	jrow = 0
	do 20 j = 1, nr2

	  call rowio( nc, r, -1, isw, jsw, ie )
	  if ( ie .eq. 1 ) go to 99

	  i = 1
	  do 30 i2 = 1, nc2
	    r2(i2) = r(i)
	    i      = i + iskip
30      continue
	  call rowio( nc2, r2, 0, isw, jsw, ie )
	  jrow = jrow + 1

	  do 40 k2 = 1, k
	    read( isw, end=99 )
40      continue

20	continue

99	if ( jrow .ne. nr2 ) then
	  write(*,*) 'output only', jrow
	  write(*,*) ' out of    ',  nr2, '  rows'
	endif 
	close(10)
	close(11)
	stop
	end
c******************************************************************************
	subroutine rowio( n, z, iop, idev, jdev, iend )
c  read iop<0, write iop=0, r&w iop=1
	dimension z(n)
	iend = 0
	if ( iop ) 1, 2, 1
1	read(idev,end=10) y, z
	if ( iop ) 9, 9, 2
2	write(jdev) y, z
9	return
10	iend=1
	return
	end



