      program makepal
c
c make a color palette for NCSA image tools to use.
c
c GWH 12-Nov-1992

      implicit none

      character*1 pal(3,256)
      character filename*80

      integer i,j

c      integer dssdast,dsadata
c      integer dfpgetpal
c      integer dfpputpal
c      integer iret

c Red, Green, Blue intensities in pal(1,i), pal(2,i), pal(3,i)
c for each of i=1,256 colors

c      do i=1,256
c         pal(1,i)=char(i-1)
c         pal(2,i)=char(255-max(0,i-128))
c         pal(3,i)=char(i-1)
c      enddo

c Turquoise at left, fluorescent violet at right (looked too blue):
c      filename='hot.pal'
c      do i=1,256
c         pal(1,i)=char(i-1)
c         pal(2,i)=char(256-i)
c         pal(3,i)=char(255)
c      enddo


c Turquoise, yellow, fluorescent violet 
c (appears to have slow contrast at ends, but hard copy looks good):
c      filename='tri0.pal'
c      do i=1,256
c         pal(1,i)=char( min(255, 2*(i-1)      ) )
c         pal(2,i)=char( min(255, 2*(256-i)    ) )
c         pal(3,i)=char( min(255, 2*abs(i-129) ) )
c      enddo

c Yellow, Turquoise, fluorescent violet 
c (appears to have slow contrast at ends, but hard copy looks good):
      filename='blu2.pal'
      do i=1,256
         pal(1,i)=char( min(255, 2*(i-1)      ) )
         pal(3,i)=char( min(255, 2*(256-i)    ) )
         pal(2,i)=char( min(255, 2*abs(i-129) ) )
      enddo

c Turquoise, yellow, fluorescent violet, with faster contrast:
c      filename='trif.pal'
c      do i=1,256
c         pal(1,i)=char( min(255, 2*(i-1)*(i-1)/128   ) )
c         pal(2,i)=char( min(255, 2*(256-i)    ) )
c         pal(3,i)=char( min(255, 4*abs(i-129) - 2*(i-129)**2/128 ) )
c      enddo

c Add black stripes to aid perception of fine scale,
c except at i=128 to avoid making large, irrelevant black regions for
c the intermittent turbulence case;

      do i=16,240,16
c         if(i .ne. 128) then
         pal(1,i)=char(0)
         pal(2,i)=char(0)
         pal(3,i)=char(0)
c         endif
      enddo

c Make the black stripes 2 bits wide for added intensity:

      do i=17,241,16
c         if(i .ne. 129) then
         pal(1,i)=char(0)
         pal(2,i)=char(0)
         pal(3,i)=char(0)
c         endif
      enddo


c make first two colors black and white (for text):
      pal(1,1)=char(0)
      pal(2,1)=char(0)
      pal(3,1)=char(0)
      pal(1,2)=char(255)
      pal(2,2)=char(255)
      pal(3,2)=char(255)

c write the resulting palette:

c      filename = ' '
c      do while (filename .eq. ' ')
c         write(6,*) ' Palette file name to write:'
c         read(5,*) filename
c         if(filename .eq. 'q') stop
c      enddo

      open(unit=20,file=filename,status='new',err=22)
      write(20,15) ((pal(i,j),j=1,256),i=1,3)
 15   format(768a1,$)
      close(unit=20)
      stop

 22   write(6,*) 'Unable to write file ', filename

c Next, is the official HDF way to write a palette file, but since
c it is so easy to do it with standard fortran (above), we'll just
c use that.
c      iret=DFPputpal(filename,pal,0,'w')
c      if(iret .ne. 0) then
c         write(6,*) 'error. iret=',iret
c         stop
c      endif

      stop
      end
