c ADDSCALE
c
c  Adds a linear scale bar to the right side of a grid
c  Jeff Phillips
c
      character*50 ifile,ofile
      character*1 ans
      integer offset,width
      dimension f(2000),id(14)
      data dval/1.e38/,ddval/1.e37/
      call pfinit('addscale')
50    write(6,1)
1     format(' Enter input file name:'/' *'$)
      read(5,100)ifile
100     format(a)
c      open(10,file=ifile,form='unformatted',status='old')
      call gopen(10,ifile,'old','read',ierr)
      if(ierr.ne.0) then
        print*,'Error - try again'
        go to 50
      endif
60    write(6,201)
201   format(1x,'Enter output file name:'/' *'$)
      read(5,100)ofile
c      read(10)id,pgm,ncol,nrow,nz,x0,dx,y0,dy
      call gheader('r',10,id,ncol,nrow,x0,dx,y0,dy,ierr)
      print*,'ncol = ',ncol,'   nrow = ',nrow
c      if(ncol.gt.2000.or.nz.ne.1.or.dx.eq.0.e0) go to 900
      if(ncol.gt.2000.or.dx.eq.0.e0) go to 900
c      open(11,file=ofile,form='unformatted',status='new')
      call gopen(11,ofile,'new','write',ierr)
      if(ierr.ne.0) then
        print*,'Error - try again'
        go to 60
      endif
      write(6,202)
202   format(' Enter offset (columns):'/' *'$)
      read*, offset
      write(6,203)
203   format(' Enter width (columns):'/' *'$)
      read*, width
      write(6,204)
204   format(' Enter height (rows):'/' *'$)
      read*, length
      if(length.gt.nrow) length=nrow
      fmin=1.e38
      fmax=-1.e38
      do 10 j=1,nrow
c        call rowio(f,y,1,ncol,10,1)
      call grow('r',10,y,f,ncol,ierr)
      do 10 i=1,ncol
      if(f(i).ge.ddval) go to 10
      if(f(i).gt.fmax) fmax=f(i)
      if(f(i).lt.fmin) fmin=f(i)
   10 continue
      print *,'fmin = ',fmin,'  fmax = ',fmax
      write(6,205)
205   format(' Do you want to change the bounds?:'/' *'$)
      read(5,100) ans
      if(ans.eq.'y'.or.ans.eq.'Y') then
        write(6,206)
206     format(' Enter min, max data bounds:'/' *'$)
        read*, fmin,fmax
        if(fmin.ge.fmax)go to 900
      endif
c206   write(6,205)
c205   format(' Enter dval option;'/4x,'1: Dvals unchanged.',
c     1 /4x,'2: Dvals set equal to min.'/4x,'3: Dvals set equal to max.
c     2 '/' *'$)
c      read*, iopt
c      if(iopt.ne.1.and.iopt.ne.2.and.iopt.ne.3)then
c        print*,' Must be 1, 2 or 3.'
c        go to 206
c      endif
      ncol2=ncol+offset+width
c      write(11)id,pgm,ncol2,nrow,nz,x0,dx,y0,dy
      call gheader('w',11,id,ncol2,nrow,x0,dx,y0,dy,ierr)
c      rewind(10)
c      read(10) id
      call gheader('r',10,id,ncol,nrow,x0,dx,y0,dy,ierr)
      do 20 j=1,nrow
c        call rowio(f,y,1,ncol,10,1)
        call grow('r',10,y,f,ncol,ierr)
        if(j.lt.(nrow-length)/2.or.j.gt.(nrow+length)/2) then
          const=dval
        else
          const=fmin+(fmax-fmin)*float(j-(nrow-length)/2)/
     1          float(length)
        endif
      do 12 i=ncol+1,ncol+offset
        f(i)=dval
   12 continue
      do 14 i=ncol+offset+1,ncol2
      f(i)=const
   14 continue
c      call rowio(f,y,1,ncol2,11,2)
      call grow('w',11,y,f,ncol2,ierr)
   20 continue
      go to 998
900   write(6,901)
901   format(' Can''t handle it.')
998   call gclose(11,'keep')
999   call gclose(10,'keep')
      stop
      end
c      subroutine rowio(a,y,nz,ncol,ld,key)
c      dimension a(nz,ncol)
c      go to (1,2),key
c1     read(ld) y,a
c      go to 90
c2     write(ld)y,a
c90    return
c      end

