c cshade.for
c
c produce color shaded relief r,g,b grids from output of shade and rainbow.
c
c Jeff Phillips 8 Aug 91
c               22 Jul 94 - changed to permit extra columns in color grids
c                           in order to accomodate ADDSCALE scale bar.
c
      dimension s(3000),r(3000),g(3000),b(3000)
      dimension id(14),pgm(2)
      character*50 ifile
      data ddval/1.e37/
      print *,'Enter name of shade grid file:'
      read(5,100) ifile
  100 format(a)
      open(10,file=ifile,form='unformatted',status='old')
      open(11,file='red.grd',form='unformatted',status='old')
      open(12,file='green.grd',form='unformatted',status='old')
      open(13,file='blue.grd',form='unformatted',status='old')
      open(14,file='sred.grd',form='unformatted',status='unknown')
      open(15,file='sgreen.grd',form='unformatted',status='unknown')
      open(16,file='sblue.grd',form='unformatted',status='unknown')
      read(10)id,pgm,ncs,nrs,nz,xo,dx,yo,dy
      read(11)id,pgm,ncol,nrow,nz,xo,dx,yo,dy
      if(nrs.ne.nrow) stop '# of rows differ in shade and color grids'
      if(ncs.gt.ncol) stop 'too many columns in shade grid'
      read(12)id
      read(13)id
      write(14)id,pgm,ncol,nrow,nz,xo,dx,yo,dy
      write(15)id,pgm,ncol,nrow,nz,xo,dx,yo,dy
      write(16)id,pgm,ncol,nrow,nz,xo,dx,yo,dy
      do 20 j=1,nrow
      read(10) dlt,(s(i),i=1,ncs)
      read(12) dlt,(g(i),i=1,ncol)
      read(11) dlt,(r(i),i=1,ncol)
      read(13) dlt,(b(i),i=1,ncol)
      do 10 i=1,ncol
      if(s(i).gt.ddval) go to 10
      if(i.gt.ncs) go to 5
c      if(i.gt.ncs) go to 10
c      if(s(i).gt.ddval) go to 9
      r(i)=r(i)*(s(i)+1.)
      g(i)=g(i)*(s(i)+1.)
      b(i)=b(i)*(s(i)+1.)
      go to 10
c    5 if(r(i)+g(i)+b(i).eq.0.0) go to 8
c    5 if(r(i).eq.1.0.and.g(i).eq.1.0.and.b(i).eq.1.0) go to 9
    5 if(r(i).eq.1.0.and.g(i).eq.1.0.and.b(i).eq.1.0) go to 10
c      fact=2.*float(i-istart)/float(ncol-istart)
c      r(i)=fact*r(i)
c      g(i)=fact*g(i)
c      b(i)=fact*b(i)
      r(i)=2.*r(i)
      g(i)=2.*g(i)
      b(i)=2.*b(i)
      go to 10
c    8 istart=i
c    9 r(i)=0.
c      g(i)=0.
c      b(i)=0.
   10 continue
      write(14) dlt,(r(i),i=1,ncol)
      write(15) dlt,(g(i),i=1,ncol)
      write(16) dlt,(b(i),i=1,ncol)
   20 continue
      stop
      end
