      include 'fgraph.fi'
      subroutine grdclr(z,b,cr,idev,ldev,numcol,black,iblack,ierr)
c      include 'pxz99.cmn'
      include '\pf\source\plot\pxz99.cmn'
      integer*2 itemp,itemp1,jtemp,fgd1,dum2,settextcolor,
     & setvideomode
      integer dum1,bgd1,setbkcolor
      dimension z(1),b(1),cr(1)
      common /setxy/ xx(2),yy(2),xp1(4),yp1(4),iplotr,sizel,
     1 ncharx,nchary,sizex,sizey,adelx,adely,pllx,plly,
     & lintx,linty,xscale,yscale,xxscal,yyscal,mscale,delx,dely
      common /contrc/ cmin,cmax,dcval,ncval,nsec,gradi,
     1                acdel(200),acgrad(200),jcdash(200),
     2                ncval2,acsize(200),acmin(200),acmax(200)
      common /contur/ acval(200)
      character*1 ctype
      common/captur/icapt,iwhite,ctype
      character*64 title
      character*16 fmtc,chars
      integer*4 ichars(4)
      common/gridsp/ iright,jupp
      common/scalef/ iwc0,jwc0,nxhpix,nyhpix,xpix,ypix,xscr,yscr
      logical black
      equivalence (chars,ichars)
      data maxcol/62/,w/10./,xstd/640./,
     & sizec/.12/,maxsh/8/,ivmax/8/,fgd1/14/,bgd1/1/

      ierr=0

c*****DETERMINE NUMBER OF COLORS
            if(ipltr.eq.8) ncolor=4
            if(ipltr.eq.9) ncolor=16
            if(ipltr.eq.10) ncolor=16
            if(ipltr.eq.11) ncolor=256

c*****NCOLOR IS IN PXZ99.CMN AND DETERMINED FROM PLOT SYSTEM
      if(ctype.eq.'c') nc=min0(maxcol,(ncolor-2))
      if(ctype.eq.'s') nc=maxsh
      if(ncval.eq.0) then
10      bcont = cr(1)/dcval
        icont = int(bcont)
        if(aint(bcont).ne.bcont.and.bcont.lt.0.) icont = icont - 1
        cbase = icont * dcval
        ucont = (cr(2)-cbase)/dcval 
        numcol = int(ucont)
        if(aint(ucont).ne.ucont) numcol = numcol + 1
c        print *,'numcol,cr(2),cr(1),dcval,icont,cbase,ncolor',
c     & numcol,cr(2),cr(1),
c     & dcval,icont,cbase,ncolor
c        pause
          if (numcol.gt.nc) then
            dcval= dcval * 2.
            go to 10
          endif
      else if((ncval-1).gt.nc) then
             dum=setvideomode($DEFAULTMODE)
             dum1= setbkcolor(bgd1)
             dum2=settextcolor(fgd1)
             call clearscreen($GCLEARSCREEN)
             write(*,'(2a)') ' more acval contour levels than',
     &                       ' allowed'
             ierr=1
             return
      else
        numcol=ncval-1
      endif

c*****GET NUMCOL COLORS
c*****COLOR 0 IS BACKGROUND COLOR SET IN CALL TO PLOT SYSTEM
c*****SUBROUTINE PCOLOR SETS COLORS 1 THROUGH NUMCOL 
c*****ENTRY REMAP2 SETS COLORS 1 THROUGH NCLR (248) FOR
c*****COLOR SHADED RELIEF

      if(ctype.eq.'s') then
        call remap2(nclr)
      else
        call pcolor(numcol)
        if(iplotr.eq.11) call remap3
      endif

      rewind(idev)
      read(idev) title,ncol,nrow,nz,xo,dx,yo,dy 
      black = .true.

      if(ctype.eq.'s') then
        rewind(ldev)
        read(ldev) 
        black = .false.
      endif

      if(black) open(iblack,form='unformatted',status='scratch')
 

c     do selected rows
      do 70 j=1,nrow
       call rowins(z,ncol,idev)

      if(ctype.eq.'s') then
        call rowins(b,ncol,ldev)
      endif


c     do selected columns
      do 50 i=1,ncol

c     Determine color from grid value...
       if(z(i).gt.cr(2).or.z(i).lt.cr(1)) then
         iclr=iwhite
         go to 47
       else if(ncval.eq.0) then
         iclr = (z(i) - cbase)/dcval + 1  
       else 
         do 40 k=2,ncval 
         if(z(i).lt.acval(k)) go to 45
 40      continue
 45      iclr=k - 1
       endif

      if(ctype.eq.'s') then
       if(b(i).ge.1.0e+37) then
         iclr=iwhite
         go to 47
       endif
c******* get primary color
         call pcol(iclr,icolor,iprime)
c******* set brightness value
	  call cshade( icolor, b(i),ishade )
c******* output shaded color number
         call pcol2(iclr,ishade,iclr)
      endif
c       call rect( i,j,iclr,1,ncol,1,nrow)
47      call onepix( i,j,iclr,ncol,black,iblack)

 50   continue
 70   continue

c*****DETERMINE RATIOS FOR PLOTTING COLOR SCALE
      xratio = (xrasx-1)/xstd
      iw = w * xratio
      iw2 = iw/2 


c*****PLOT COLOR SCALE
      itemp = iwc0 + xscr + iw
      itemp1 = itemp + iw
      jdiv=yscr/numcol
      js=1
      je=jdiv

      do 90 jclr=1,numcol
      do 80 j=js,je

      if(ctype.eq.'s') then
        call pcol(jclr,icolor,iprime)
        call mcolor(iprime)
      else
        call mcolor(jclr)
      endif
      jtemp = jwc0 - (j-1)
      call makel(itemp,jtemp,itemp1,jtemp)
 80   continue
      js=je+1
      je=je+jdiv
 90   continue

c*****FIND FORMAT AND SIZE FOR PLOTTING VALUES

        ab = abs(cr(1))
        au = abs(cr(2))
        n1=ifix(alog10(au))
        n2=iabs(n1)
        n3=ifix(alog10(ab))
        n4=iabs(n3)
        if(n2.gt.n4) then
          nchar = n2 + 2
          ndec = n2 + 1
          if(cr(2).lt.0.) nchar = nchar + 1
          cont2 = au
        else
          nchar = n4 + 2
          ndec = n4 + 1
          if(cr(1).lt.0.) nchar = nchar + 1
          cont2 = ab
        endif
        if(cont2.ge.1.) then
          ndec=0
          nchar2=nchar-1
        else
          nchar2=nchar
        endif
      if(iplotr.eq.8.or.iplotr.eq.11) ivmax = 7
      if(nchar2.le.ivmax) then
        write(fmtc,'(''(f'',i2,''.'',i2,'')'')') nchar,ndec
      else if(ivmax.gt.7) then
        write(fmtc,'(''(e'',i2,''.2)'')') ivmax
        nchar2 = ivmax
      else
        write(fmtc,'(''(e'',i2,''.1)'')') ivmax
        nchar2 = ivmax
      endif

      sizeh = sizec
      if(iplotr.eq.8.or.iplotr.eq.11) then
        if(nchar2.le.(ivmax - 2)) then
          sizeh = sizec * 1.66667
        else if(nchar2.eq.(ivmax-1)) then
          sizeh = sizec * 1.5
        else 
          sizeh = sizec * 1.33333
        endif
      endif
      iht=nint(sizeh*yrasp)

c*****PLOT COLOR VALUES
      if(ctype.eq.'c') then
        xtemp2=(itemp1 + 6)/xrasp
      else
        xtemp2=(itemp1 + 3)/xrasp
      endif
      con = cbase 
      do 95 inc=1,10
      if((jdiv*inc)-iht.gt.iw2) go to 97
95    continue
97    do 100 i=1,numcol+1,inc
      jtemp =yrasx - ( jwc0 - (jdiv * (i-1) - 1 ) )
      if(ncval.eq.0) then
        con = cbase + (dcval * (i-1)) 
      else
        con = acval(i)
      endif
      write(chars,fmtc) con
      call vchar(xtemp2,jtemp/yrasp,ichars,nchar2,
     & (iwhite*100)+3,sizeh,0.,0.,0.)
100   continue
      if(black) rewind iblack
      return
      end

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine rect(ii,jj,iclr,is,ie,js,je)
c*****THIS WAS WRITTEN TO PAINT SEVERAL PIXELS IN THE X & Y DIRECTIONS
c*****WITH EACH CALL. WITH A CHANGE IN THINKING TO PAINT ONE PIXEL
c*****FOR EACH GRID VALUE,THIS SUBROUTINE IS OBSOLETE.
      common/gridsp/ iright,jupp
      common/scalef/ iwc0,jwc0,nxhpix,nyhpix,xpix,ypix,xscr,yscr
c     some of the following statements are commented to preserve
c     memory - the c must be removed if one ever wants to use
c     this subroutine
c      integer*2 xx(200),yy(200)

      itemp = iwc0 + nint((ii-is)*xpix)
      jtemp = jwc0 - nint((jj-js)*ypix)

      if(ii.eq.is) then
      istart = iwc0
c      jstart = yy(nn)-1
      nxhalf=nxhpix
      nyhalf=nyhpix
      endif

      if(ii.eq.ie) then
      nxhalf=0
      if(istart.gt.iright) istart=iright
      if(itemp.gt.iright) itemp=iright
      endif

      if(jj.eq.js) jstart = jwc0

      if(jj.eq.je) then
      nyhalf=0
      if(jstart.lt.jupp) jstart=jupp
      if(jtemp.lt.jupp) jtemp=jupp
      endif

      n=0
      do 10 i=istart,itemp+nxhalf
      n=n+1
c      xx(n)=i
   10 continue
c      istart=xx(n)+1

      nn=0
      do 20 i=jstart,jtemp-nyhalf,-1
      nn=nn+1
c      yy(nn)=i
   20 continue

      call mcolor(iclr)
      do 30 i=1,nn
c      call makel(xx(1),yy(i),xx(n),yy(i))
   30 continue
c      if(jj.eq.je) print *,'rect',iclr,jj,n,nn,xx(1),xx(n),yy(1),yy(nn)

      return
      end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine onepix(ii,jj,iclr,ncol,black,iblack)
      common/scalef/ iwc0,jwc0,nxhpix,nyhpix,xpix,ypix,xscr,yscr
      integer*2 xx(640),jtemp
      integer*1 prcol1(640),prcol2(640)
      logical black

      itemp = iwc0 + ii-1
      jtemp = jwc0 - (jj-1)

      if(ii.eq.1) then
        n=1
        jclr=iclr
        xx(n)= itemp
      else if(iclr.eq.jclr) then
        n=n+1
        xx(n)=itemp
      else
        call mcolor(jclr)
        call makel(xx(1),jtemp,xx(n),jtemp)
        if(black) then
          write(iblack) xx(n),jtemp
          do 10 i = 1,n
            if(jj.ne.1) then
              if(jclr.ne.prcol1(xx(i))) write(iblack) xx(i),jtemp
            endif
            prcol2(xx(i)) = jclr
10        continue
        endif
        jclr=iclr
        n=1
        xx(n)=itemp
      endif

      if(ii.eq.ncol) then
        call mcolor(jclr)
        call makel(xx(1),jtemp,xx(n),jtemp)
        if(black) then
          do 20 i = 1,n
            if(jj.ne.1) then
              if(jclr.ne.prcol1(xx(i))) write(iblack) xx(i),jtemp
            endif
            prcol2(xx(i)) = jclr
20        continue
          prcol1 = prcol2
        endif
      endif

      return
      end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
        subroutine rowiod(n,z,iop,idev,jdev,irec,iend)
        dimension z(n)
        iend=0
        if(iop)1,2,1
1       read(idev,rec=irec,err=10) y,z
        if(iop)9,9,2
2       write(jdev,rec=irec) y,z
9       return
10      iend=1
        return
        end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine rowins(z,ncol,in)
      dimension z(ncol)
      read(in) dum,z
      return
      end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine pcolor(numcol)
c      include 'pxz99.cmn'
      include '\pf\source\plot\pxz99.cmn'
      parameter(maxcol=62)
c      parameter(mgray=14)
      parameter (nkol=248)
      include 'fgraph.fd'
      character*1 ctype
      common/captur/icapt,iwhite,ctype
      integer*2 ii
c      integer*4 remappalette
      integer ikol(maxcol)
      integer jncl(maxcol),kncl(maxcol),mcol(maxcol),kcol(maxcol)
      integer gray62(maxcol),mncl(maxcol)
c      integer rgb,red,gr,bl
c     integer egacol(16)
c      integer gray(mgray),gkol(mgray)
      integer kol(nkol)
c*****COLOR SHADED RELIEF COLORS(248)
      data kol/
     & 3351603, 3351347, 3351091, 3350835, 3350579, 3350323, 3350067,
     & 3349811, 3349555, 3349299, 3349043, 3348787, 3348531, 3348275,
     & 3348019, 3347763, 3216433, 3150896, 3019566, 2888236, 2822699,
     & 2691369, 2560039, 2428709, 2363172, 2231842, 2100512, 2034975,
     & 1903645, 1772315, 1706778,
     & 4139562, 4139048, 4138791, 4138277, 4138020, 4137763, 4137249,
     & 4136992, 4136478, 4136221, 4135964, 4135450, 4135193, 4134679,
     & 4134422, 4134165, 4002836, 3871764, 3740435, 3609106, 3478034,
     & 3281169, 3149840, 3018511, 2887439, 2756110, 2624781, 2493709,
     & 2362380, 2231051, 2099979,
     & 3355417, 3355415, 3355414, 3355412, 3355410, 3355409, 3355407,
     & 3355405, 3355403, 3355402, 3355400, 3355398, 3355397, 3355395,
     & 3355393, 3355392, 3223808, 3158016, 3026432, 2894848, 2829056,
     & 2697472, 2565888, 2434304, 2368512, 2236928, 2105344, 2039552,
     & 1907968, 1776384, 1710592,
     & 2047775, 1916701, 1785627, 1654553, 1523479, 1392405, 1195794,
     & 1064720,  933646,  802572,  671498,  540424,  409350,  278276,
     &  147202,   16128,   15616,   15104,   14592,   14080,   13568,
     &   12800,   12288,   11776,   11264,   10752,   10240,    9728,
     &    9216,    8704,    8192,
     & 2047807, 1916735, 1785663, 1654591, 1523519, 1392447, 1195839,
     & 1064767,  933695,  802623,  671551,  540479,  409407,  278335,
     &  147263,   16191,   15677,   15163,   14649,   14135,   13621,
     &   12850,   12336,   11822,   11308,   10794,   10280,    9766,
     &    9252,    8738,    8224,
     & 2043711, 1912383, 1781055, 1649727, 1518399, 1387071, 1190207,
     & 1058879,  927551,  796223,  664895,  533567,  402239,  270911,
     &  139583,    8255,    7997,    7739,    7481,    7223,    6965,
     &    6706,    6448,    5934,    5676,    5418,    5160,    4902,
     &    4644,    4386,    4128,
     & 2039615, 1908031, 1776447, 1644863, 1513279, 1381695, 1184319,
     & 1052735,  921151,  789567,  657983,  526399,  394815,  263231,
     &  131647,      63,      61,      59,      57,      55,      53,
     &      50,      48,      46,      44,      42,      40,      38,
     &      36,      34,      32,
     & 4136767, 4136255, 4135743, 4135231, 4134719, 4134207, 4133439,
     & 4132927, 4132415, 4131903, 4131391, 4130879, 4130367, 4129855,
     & 4129343, 4128831, 3997757, 3866683, 3735609, 3604535, 3473461,
     & 3276850, 3145776, 3014702, 2883628, 2752554, 2621480, 2490406,
     & 2359332, 2228258, 2097184/
c*****62 CONTINUOUS COLORS
      data mcol/
     & 1903642, 2100509, 2363168, 2363680, 2364192, 2364705, 2365217,
     & 2365730,
     & 3281169, 3740435, 4134165, 4135193, 4136221, 4137249, 4138277,
     & 4139562,
     & 2697472, 3026432, 3355392, 3355397, 3355402, 3355407, 3355412,
     & 3355417,
     &   12800,   14592,   16128,  409350,  802572, 1195794, 1654553,
     & 2047775,
     &   14649,   16191,  409407,  802623, 1195839, 1654591,
     & 2047807,
     & 2043711, 1649727, 1190207,  796223,  402239,    8255,    7481,
     &    6706,
     &      50,      57,      63,  394815,  789567, 1184319,
     & 1644863,
     & 3276850, 3735609, 4128831, 4130367, 4131903, 4133439, 4135231,
     & 4136767/
c*****62 COLORS FROM ORIGINAL 79 BANDED COLORS
      data kcol/
     & 4130848, 4134944, 4132896, 4136992, 4133920,
     & 4136996, 4134952, 4137000, 4139008, 4141088, 4141056, 4143136,
     & 4143104, 4144928, 4143112, 3948320, 4144896, 4144936, 4144912,
     & 3620648,   14336, 1589024, 1588992,   16160, 1589000, 1326888,
     & 1589008, 2113320, 2112552, 2375476, 2374704,
     & 1589044, 1326128,  802612,  802608,   16184,   16176,  278328,
     &  540476,  802616,  277564,  540479,
     &  796735, 1585215,    8255, 2107455,
     &  531519, 1583167, 1054783, 2105407,  528447, 1581119, 
     & 4139064, 4139071, 4137016, 4134975, 4132920, 4132927,
     & 4128824, 4128831, 3670072, 3145791/
c****ORIGINAL 79 COLORS
c      data incl/1,79,16,70,62,22,36,46,68,8,54,26,74,44,12,64,
c     & 30,18,52,4,24,38,34,56,72,14,48,20,58,40,6,32,66,50,10,76,
c     & 28,42,60,2,61,29,43,77,67,11,51,33,9,41,59,21,49,73,15,35,
c     & 25,57,39,5,53,31,19,65,13,45,27,75,55,7,69,37,23,47,63,17,
c     & 71,78,3/
c*****INDEXES FOR MODIFIED 79 COLORS TO 62 COLORS
      data kncl/1,16,62,22,36,46,8,54,26,44,12,
     & 30,18,52,4,24,38,34,56,14,48,20,58,40,6,32,50,10,
     & 28,42,60,2,61,29,43,11,51,33,9,41,59,21,49,15,35,
     & 25,57,39,5,53,31,19,13,45,27,55,7,37,23,47,17,
     & 3/
c*****INDEXES FOR 62 CONTINUOUS COLORS
       data jncl/62,16,40,56,24,32,8,48,57,10,34,50,18,26,2,42,60,14,
     & 38,54,22,30,6,46,58,12,36,52,20,28,4,44,51,11,35,19,27,3,43,59,
     & 13,37,53,21,29,5,45,49,9,33,17,25,1,41,61,15,39,55,23,31,7,47/
c      data egacol/#000000,#2a0000,#002a00,#2a2a00,
c     & #00002a,#2a002a,#00152a,#2a2a2a,#151515,#3f1515,#153f15,
c     & #3f3f15,#15153f,#3f153f,#153f3f,#3f3f3f/
c*****INDEXES FOR 62 GRAY SHADES
       data mncl/62,60,58,56,54,53,52,51,50,49,48,47,46,45,44,43,42,
     & 41,29,1,15,8,26,38,12,35,23,4,32,40,14,18,28,6,37,21,10,34,25,
     & 2,16,36,11,30,20,9,27,19,5,33,24,13,17,31,7,22,3,39,55,57,59,61/

c*****62 GRAY SHADES
       data gray62/
     &   65793,  131586,  197379,  263172,  328965,  394758,  460551,
     &  526344,  592137,  657930,  723723,  789516,  855309,  921102,
     &  986895, 1052688, 1118481, 1184274, 1250067, 1315860, 1381653,
     & 1447446, 1513239, 1579032, 1644825, 1710618, 1776411, 1842204,
     & 1907997, 1973790, 2039583, 2105376, 2171169, 2236962, 2302755,
     & 2368548, 2434341, 2500134, 2565927, 2631720, 2697513, 2763306,
     & 2829099, 2894892, 2960685, 3026478, 3092271, 3158064, 3223857,
     & 3289650, 3355443, 3421236, 3487029, 3552822, 3618615, 3684408,
     & 3750201, 3815994, 3881787, 3947580, 4013373, 4079166/
c*****16 GRAY SHADES
c      data gray/#141414,#161616,#191919,#1c1c1c,#1f1f1f,
c     & #222222,#252525,#282828,#2b2b2b,#2e2e2e,#313131,
c     & #343434,#373737,#393939/
c*****INDEXES FOR 16 GRAY SHADES
c      data gkol/1,8,12,4,14,6,10,2,11,9,5,13,7,3/
c      rgb(red,gr,bl)=(#3f3f3f.and.(red.or.ishft(bl,16).or.ishft(gr,8)))
      n=0
      if(ctype.eq.'g') go to 20
      if(ctype.eq.'c') then
c*****GET APPROPRIATE CONTINUOUS COLOR  
        do 10 i=1,maxcol                                                    
        if(jncl(i).gt.numcol) go to 10                                    
        n=n+1                                                               
        ikol(n)=mcol(i)
   10   continue                                                             
        go to 40
      else
c*****GET APPROPRIATE BANDED COLOR  
        do 15 i=1,maxcol                                                      
        if(kncl(i).gt.numcol) go to 15                                      
        n=n+1                                                           
        ikol(n)=kcol(i)
   15   continue                                                            
        go to 40
      endif
c*****GET APPROPRIATE GRAY SCALE
   20 do 30 i=1,maxcol
      if(mncl(i).gt.numcol) go to 30                                            
      n=n+1                                                                     
      ikol(n)=gray62(i)
   30 continue

c*****REMAP COLORS
40    do 50 ii=1,n
      istat=remappalette(ii,ikol(ii))
   50 continue
      return

c*****GET SHADED RELIEF COLOR 
      entry  pcol2(iclr,ishade,icol)
      is = (iclr-1) * 31 + 1
      ie = is + 30
      do 60 icol = is,ie
      if(ishade.gt.kol(icol)) then
        if(icol.eq.is) then
          return
        else
          idiff=kol(icol-1) -ishade
          jdiff=ishade-kol(icol)
          inear=min(idiff,jdiff)
          if(inear.eq.idiff) go to 70
          return 
        endif
      endif
60    continue
      icol=ie
      return
70    icol=icol-1
      return

c*****GET PRIMARY COLOR FOR SHADED RELIEF
      entry pcol(iclr,icolor,i)
      i= (iclr-1) * 31 + 16
      icolor=kol(i)
      return

      entry remap2(nclr)
c*****REMAP COLORS FOR SHADED RELIEF
      do 80 ii=1,nkol
      istat=remappalette(ii,kol(ii))
80    continue
      nclr=nkol
      istat=remappalette(250,#153f3f)
      return
c*****REMAPS COLOR 250 TO YELLOW FOR OPTIONS AFTER PLOTTING
      entry remap3
      istat=remappalette(250,#153f3f)
      return
      end
c*******************************************************************************
	subroutine cshade( icolor, brite, ishade )
c    transform color value to lighter or darker shade.
c  primary colors range from 0 ( no color ) to icmax ( saturated ).
c  'icolor' ( input color ) is defined midway in the brightness range, 
c           where at least one primary is icmax and one primary is zero.
c  'brite'  range is -1 (black) to 1 (white) with zero as no change.
c  'icmx'   optional saturation, include for gray shades where 
c           icolor(1:3)= ( icmax/2, icmax/2, icmax/2 ).
c
c  colors are lightened by reducing color values, keeping the same ratio.
c  colors are darkened by adding complementary color.
c
      integer rgb,red,gr,bl
      dimension jcolor(3)
      rgb(red,gr,bl)=(#3f3f3f.and.(red.or.ishft(bl,16).or.ishft(gr,8)))

	if ( brite .eq. 0 ) then
       ishade=icolor
       return
       endif

	bright = -brite
       jcolor(1)=#00003f.and.icolor
       jcolor(2)=ishft((#003f00.and.icolor),-8)
       jcolor(3)=ishft((#3f0000.and.icolor),-16)
c
	if ( bright .gt. 0 ) then
c  lighten color
	  ratio = 1.0 - bright
         do i = 1, 3
 	    jcolor(i) = nint( ratio * float( jcolor(i) ) )
         enddo
         ishade = rgb(jcolor(1),jcolor(2),jcolor(3))
c
       else
c  darken color with complementary color
       icmax = max( jcolor(1), jcolor(2), jcolor(3) )
	do i = 1, 3
	  icomp = int( -bright * float( icmax - jcolor(i) ) )
	  jcolor(i) = jcolor(i) + icomp
	enddo
       ishade = rgb(jcolor(1),jcolor(2),jcolor(3))
       endif
c
	return
	end
