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*56, p*8, p2*8
cv      character if*72, jf*72, kf*72
      character if*72, jf*72
      data p2 / 'trnsposd' /
      data nz / 1 /
cv      data kf / 'mtx.tmp' /
      data inp / 5 /
c
      write(*, 1) 
    1 format(8h ifile: $)
      read(inp, 100) if
      write(*, 2) 
  100 format(a72)
    2 format(8h ofile: $)
      read(inp, 100) jf
      write(*, 3) 
    3 format(22h enter 1 for transpose,/,28h       2 for 90 deg rotation
     &,/,28h       3 for column reverse:$)
      irot = 0
      read(inp, *) irot
      if (irot .lt. 3) goto 6
      open(12, file=if, form='unformatted', status='old') 
cv    open(10, file=jf, form='unformatted', status='new')
c      open(10, file=jf, form='unformatted', status='unknown')
      goto 40
    6 open(10, file=if, form='unformatted', status='old') 
cv    open(12,file=jf,form='unformatted',status='new')
      if(irot.eq.1) then
        open(12, file=jf, form='unformatted', status='unknown')
      else
        open(12, form='unformatted', status='scratch')
      endif
      read(10) id, p, nc, nr, nz, xo, dx, yo, dy
      if (nc .gt. 2500) stop 'x too big'
      if (nr .gt. 2500) stop 'y too big'
      n = int((float(nr) / 20.) + .999)
      m = int((float(nc) / 20.) + .999)
      n10 = n * 20
      m10 = m * 20
      nm = n10 * m10
cv    open(11, file=kf, access='direct', status='scratch', recl=
cv   &1600) 
      open(11, access='direct', status='scratch', recl=1600) 
      call rio(nc, buf, m, n, 1, 1, m10, -1)
      write(*, 4) 
    4 format(7h title:)
      read(inp, 5) id
    5 format(a)
      write(12) id, p2, nr, nc, nz, yo, dy, xo, dx
      ic = 1
      do 10 ibuf = 1, m
      loc = ibuf
      call rio(nr, buf, n, 0, loc, m, n10, 1)
      ndx = 1
      do 20 i = 1, 20
      call rowio(nr, buf(ndx), 0, 12, 12, iend)
      if (ic .eq. nc) goto 99
      ic = ic + 1
   20 ndx = ndx + n10
   10 continue
   99 continue
      close(11) 
      rewind(12) 
      close(10)
c
   40 if (irot .le. 1) goto 90
cv    open(10, file=jf, form='unformatted', status='new')
      open(10, file=jf, form='unformatted', status='unknown') 
      read(12) id, p, nc, nr, nz, xo, dx, yo, dy
      p = '90d rota'
      xo = ((nc - 1) * dx) + xo
      dx = - dx
      if (irot .lt. 3) goto 41
      p = 'rev col'
   41 write(10) id, p, nc, nr, nz, xo, dx, yo, dy
      do 45 j = 1, nr
      i2 = nc + nc
      call rowio(nc, buf(1), -1, 12, 12, ie)
      do 42 i = 1, nc
      buf(i2) = buf(i)
   42 i2 = i2 - 1
      call rowio(nc, buf(nc + 1), 0, 10, 10, ie)
   45 continue
      close(10) 
   90 close(12) 
      stop 
      end
      subroutine rio(na, z[HUGE], nblk, nbuf, loc2, idl, n10, iop)
      dimension w(400)
      dimension z(1), is(2)
cv    data dval/'37777677777'o/
      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 call rowio(na, z(ii), -1, 10, 10, ie)
      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(11, rec=loc) w
   30 loc = loc + idl
c
      goto ir
    3 do 40 iblk = 1, nblk
      read(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
      subroutine rowio(n, z[HUGE], iop, idev, jdev, iend)
c  WHERE IOP<0 READ; IOP=0 WRITE; IOP>0 READ&WRITE
      dimension z(n)
      iend = 0
      if (iop) 1, 2, 1
    1 read(idev, end=10) xo, z
      if (iop) 9, 9, 2
    2 write(jdev) xo, z
    9 return 
   10 iend = 1
      return 
      end
