c  program transpose
c  flips grid about the diagonal, rotates 90 deg., or reverses columns
c
c   Mike Webring
c   Regional Geophysics, USGS
c   Lakewood, Co.
c
      dimension buf(50000)
      character id*80
      character if*80, jf*80, kf*80
c
      data nz / 1 /
      data kf / 'mtx.tmp' /
      data inp / 5 /
C Call ODDF init. routine
       call pfinit('transpos')
c
      write(6,*) ' Enter the input file name.'
      read(unit=inp, fmt=100) if
  100 format(a80)
      call gopen(10,if,'old','read',ierror)
      call gheader('r',10,id,nc,nr,xo,dx,yo,dy,ierror)
      if (nc .gt. 2500) stop 'x too big'
      if (nr .gt. 2500) stop 'y too big'
      write(6,*) ' Enter the output file name.'
      read(unit=inp, fmt=100) jf
      call gopen(11,jf,'new','write',ierror)
      write(unit=*, fmt=3) 
    3 format(22h enter 1 for transpose,/,28h       2 for 90 deg rotation
     &,/,28h       3 for column reverse:$)
      irot = 0
      read(unit=inp, fmt=*) irot
      if (irot.eq.1) then
        call gheader('w',11,id,nr,nc,yo,dy,xo,dx,ierror)
        call gxpose(10,11,nc,nr,buf,50000)
      endif
      if (irot.eq.2) then
        call gheader('w'



      if (irot .lt. 3) goto 6
      call gopen(12,if,'old','read',ierror)
      call gheader('r',12,id,nc,nr,xo,dx,yo,dy,ierror)
      goto 40
6     call gopen(10,if,'old','read',ierror)
      call gheader('r',10,id,nc,nr,xo,dx,yo,dy,ierror)
      if (nc .gt. 2500) stop 'x too big'
      if (nr .gt. 2500) stop 'y too big'
      call gopen(12,jf,'new','write',ierror)
      call gheader('w',12,id,nr,nc,yo,dy,xo,dx,ierror)
      n = int((float(nr) / 20.) + .999)
      m = int((float(nc) / 20.) + .999)
      n10 = n * 20
      m10 = m * 20
      nm = n10 * m10
      open(unit=11, access='direct', status='scratch', recl=
     &1600) 
	  irow = 0
      call rio(nc, buf, m, n, 1, 1, m10, -1, irow)
      write(unit=*, fmt=4) 
    4 format(7h title:)
      read(unit=inp, fmt=5) id
    5 format(a80)
      ic = 1
	  irow = 0
      do 10 ibuf = 1, m
      loc = ibuf
      call rio(nr, buf, n, 0, loc, m, n10, 1, irow)
      ndx = 1
      do 20 i = 1, 20
		irow = irow + 1
		print *,' Loc 1 reading row ',irow
        call rowio(nr, buf(ndx), 0, 12, 12, iend,irow,irow)
      if (ic .eq. nc) goto 99
      ic = ic + 1
   20 ndx = ndx + n10
   10 continue
   99 continue
      close(unit=11) 
c
      call gclose(10,'keep')
   40 if (irot .le. 1) goto 90
	  call gopen(10,jf,'new','write',ierror)
	  call gh1f4('w',10,id,nc,nr,xo,dx,yo,dy,ierror)
c      open(unit=10, file=jf, form='unformatted', status='unknown') 
c      read(unit=12) id, p, nc, nr, nz, xo, dx, yo, dy
      xo = ((nc - 1) * dx) + xo
      dx = - dx
      do 45 j = 1, nr
      i2 = nc + nc
		print *,' Loc 2 reading row ',j
      call rowio(nc, buf(1), -1, 12, 12, ie, j, j)
      do 42 i = 1, nc
      buf(i2) = buf(i)
   42 i2 = i2 - 1
      call rowio(nc, buf(nc + 1), 0, 10, 10, ie, j, j)
   45 continue
      call gclose(10,'keep') 
   90 call gclose(12,'keep') 
      stop 
      end
      subroutine rio(na, z, nblk, nbuf, loc2, idl, n10, iop, krow)
      dimension w(400)
      dimension z(1), is(2)
      data dval / 1.0e+38 /
      loc = loc2
      assign 999 to ir
      if (iop) 1, 2, 3
    1 iflag = 1
      assign 99 to ir
      is(1) = na + 1
      is(2) = 1
      assign 10 to ig
      if (n10 .eq. na) goto 15
      assign 12 to ig
   15 do 100 ibuf = 1, nbuf
      ii = 1
      do 10 irow = 1, 20
      goto (11, 12), iflag
   11 krow = krow + 1
		print *,' Loc 3 reading row ',krow
	  call rowio(na, z(ii), -1, 10, 10, ie, krow, krow)
      if (ie .eq. 1) goto 14
      ii = ii + n10
      goto ig
   14 iflag = 2
   12 kk = (irow - 1) * n10
      do 13 k = kk + is(iflag), kk + n10
   13 z(k) = dval
   10 continue
      goto 2
   99 continue
  100 continue
      loc1 = loc - 1
c
      return 
    2 do 30 iblk = 1, nblk
      lw = 1
      ls = ((iblk - 1) * 20) + 1
      do 21 j = 1, 20
      l2 = ls
      l = lw
      do 20 i = 1, 20
      w(l) = z(l2)
      l = l + 20
   20 l2 = l2 + 1
      lw = lw + 1
   21 ls = ls + n10
      write(unit=11, rec=loc) w
   30 loc = loc + idl
c
      goto ir
    3 do 40 iblk = 1, nblk
      read(unit=11, rec=loc) w
      loc = loc + idl
      l = 1
      ls = ((iblk - 1) * 20) + 1
      do 51 j = 1, 20
      l2 = ls
      do 50 i = 1, 20
      z(l2) = w(l)
      l = l + 1
   50 l2 = l2 + 1
   51 ls = ls + n10
   40 continue
  999 return 
      end
c  WHERE IOP<0 READ; IOP=0 WRITE; IOP>0 READ&WRITE
      subroutine rowio(n, z, iop, idev, jdev, iend,irow,jrow)
      dimension z(n)
      iend = 0
      if (iop) 1, 2, 1
1	  call growf4('r',idev,irow,z,n,ierror)
	  if(ierror .ne. 0) goto 10
c    1 read(unit=idev, end=10) xo, z
      if (iop) 9, 9, 2
2	  call growf4('w',jdev,jrow,z,n,ierror)
c    2 write(unit=jdev) xo, z
    9 return 
   10 iend = 1
      return 
      end
