C 
C Program PALLET to interpolate colour tables.
C
C Version: 5.20
C Date: 1998, October 21
C
C Coded by: Ludek Klimes
C     Department of Geophysics, Charles University Prague,
C     Ke Karlovu 3, 121 16 Praha 2, Czech Republic,
C     E-mail: klimes@seis.karlov.mff.cuni.cz
C
C.......................................................................
C
C This Fortran77 file consists of the following external procedures:
C     PALLET..Main program to interpolate colour tables.
C             PALLET
C     RGBHSV..Subroutine to convert the RGB colour representation into
C             the HSV colour representation.
C             RGBHSV
C     HSVRGB..Subroutine to convert the HSV colour representation into
C             the RGB colour representation.
C             HSVRGB
C
C No other external procedures required.
C
C.......................................................................
C
C                                                    
C Description of the data files:
C
C The data are read in by the list directed input (free format).
C In the description of data files, each numbered paragraph indicates
C the beginning of a new input operation (new READ statement).
C If the symbolic name of the input variable is enclosed in apostrophes,
C the corresponding value in input data is of the type CHARACTER, i.e.
C it should be a character string enclosed in apostrophes.  If the first
C letter of the symbolic name is I-N, the corresponding value is of the
C type INTEGER.  Otherwise, the input parameter is of the type REAL and
C may or may not contain a decimal point.
C
C Input data read from the * external unit:
C     The interactive * external unit may also be redirected to the file
C     containing the relevant data.
C (1) 'FILE1','FILE2',FACTOR,/
C     'FILE1'... String with the name of the input data file containing
C             the table assigning RGB colours to several integers.
C     'FILE2'... String with the name of the output data file containing
C             the table assigning RGB colours to all integers within the
C             range corresponding to the input.
C     FACTOR..Brightness factor.  Intensities of the input RGB colours
C             are multiplied by FACTOR.
C Default: FACTOR=1.
C
C                                                    
C Input file 'FILE1' and output file 'FILE2' with the RGB colour tables:
C     Each line contains four numbers:
C K,R,G,B
C     K...    Index of the colour.  Non-negative integer.
C     R...    Content of the red colour.  Real between 0 and 1.
C     G...    Content of the green colour.  Real between 0 and 1.
C     B...    Content of the blue colour.  Real between 0 and 1.
C
C=======================================================================
C
C     
C
C     Filenames:
      CHARACTER*80 FILE1,FILE2
C
      INTEGER K1,K2,K
      REAL  PI,FACTOR,A1,H1,S1,V1,A2,H2,S2,V2,R2,G2,B2,H,S,V,R,G,B
      PARAMETER (PI=3.141593)
C
C.......................................................................
C
      FACTOR=1.
      WRITE(*,'(2A)') ' Enter input and output colour-table filenames,',
     *                ' and brightness factor: '
      READ(*,*) FILE1,FILE2,FACTOR
C
      OPEN(1,FILE=FILE1,STATUS='OLD')
      OPEN(2,FILE=FILE2)
      READ(1,*,END=90) K2,R2,G2,B2
      IF(K2.EQ.0) THEN
        WRITE(2,'(I3,3F5.2)') K2,R2,G2,B2
      ELSE
        WRITE(2,'(I3,3F5.2)') K2,R2*FACTOR,G2*FACTOR,B2*FACTOR
      END IF
      CALL RGBHSV(R2,G2,B2,H2,S2,V2)
   10 CONTINUE
        K1=K2
        H1=H2
        S1=S2
        V1=V2
        READ(1,*,END=90) K2,R2,G2,B2
        CALL RGBHSV(R2,G2,B2,H2,S2,V2)
        DO 20 K=K1+1,K2
          A2=FLOAT(K-K1)/FLOAT(K2-K1)
          A1=1.-A2
          H=H1*A1+H2*A2
          S=S1*A1+S2*A2
          V=V1*A1+V2*A2
          IF(ABS(H1-H2).GT.PI) THEN
            IF(H1+H2.LT.2.*PI) THEN
              IF(H1.LT.H2) THEN
                H=H+2.*PI*A1
              ELSE
                H=H+2.*PI*A2
              END IF
            ELSE
              IF(H1.GE.H2) THEN
                H=H-2.*PI*A1
              ELSE
                H=H-2.*PI*A2
              END IF
            END IF
          END IF
          S=S*FACTOR
          V=V*FACTOR
          CALL HSVRGB(H,S,V,R,G,B)
          WRITE(2,'(I3,3F5.2)') K,R,G,B
   20   CONTINUE
      GO TO 10
C
   90 CONTINUE
      CLOSE(1)
      CLOSE(2)
      STOP
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE RGBHSV(R,G,B,H,S,V)
      REAL R,G,B,H,S,V
C
C Subroutine to convert the RGB colour representation into the HSV
C colour representation.
C
C Input:
C     R...    Red.
C     G...    Green.
C     B...    Blue.
C
C Output:
C     H...    Hue: red=0., green=pi*2/3, blue=pi*4/3.
C     S...    Saturation: saturation*value=pure colour
C     V...    Value = pure colour + white.
C
C No subroutines and external functions referred.
C
C Date: 1996, September 30
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
      REAL  PI
      PARAMETER (PI=3.141593)
C
C.......................................................................
C
      H=0.
      IF(R.GE.G.AND.R.GE.B) THEN
        V=R
        IF(B.GE.G) THEN
          S=(V-G)
          IF(S.GT.0.) THEN
            H=PI*11./6.-ASIN((B-G)/S-0.5)
          END IF
        ELSE
          S=(V-B)
          IF(S.GT.0.) THEN
            H=PI    /6.+ASIN((G-B)/S-0.5)
          END IF
        END IF
      ELSE IF(G.GE.B) THEN
        V=G
        IF(R.GE.B) THEN
          S=(V-B)
          IF(S.GT.0.) THEN
            H=PI* 3./6.-ASIN((R-B)/S-0.5)
          END IF
        ELSE
          S=(V-R)
          IF(S.GT.0.) THEN
            H=PI* 5./6.+ASIN((B-R)/S-0.5)
          END IF
        END IF
      ELSE
        V=B
        IF(G.GE.R) THEN
          S=(V-R)
          IF(S.GT.0.) THEN
            H=PI* 7./6.-ASIN((G-R)/S-0.5)
          END IF
        ELSE
          S=(V-G)
          IF(S.GT.0.) THEN
            H=PI* 9./6.+ASIN((R-G)/S-0.5)
          END IF
        END IF
      END IF
      IF(H.LT.0.) THEN
        H=H+2.*PI
      END IF
      IF(H.GT.2.*PI) THEN
        H=H-2.*PI
      END IF
C     IF(V.GT.0.) THEN
C       S=S/V
C     END IF
C
      RETURN
      END
C
C=======================================================================
C
C     
C
      SUBROUTINE HSVRGB(H,S,V,R,G,B)
      REAL H,S,V,R,G,B
C
C Subroutine to convert the HSV colour representation into the RGB
C colour representation.
C
C Input:
C     H...    Hue: red=0., green=pi*2/3, blue=pi*4/3.
C     S...    Saturation: saturation*value=pure colour
C     V...    Value = pure colour + white.
C
C Output:
C     R...    Red.
C     G...    Green.
C     B...    Blue.
C
C No subroutines and external functions referred.
C
C Date: 1996, September 30
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
      REAL  PI
      PARAMETER (PI=3.141593)
C
C.......................................................................
C
      R=0.
      G=0.
      B=0.
      IF(H.LE.PI/3.) THEN
        R=1.
        IF(H.LE.0.) THEN
          B=-SIN(H+PI/6.)+0.5
        ELSE
          G= SIN(H-PI/6.)+0.5
        END IF
      ELSE IF(H.LE.PI) THEN
        G=1.
        IF(H.LE.PI*2./3.) THEN
          R=-SIN(H-PI*3./6.)+0.5
        ELSE
          B= SIN(H-PI*5./6.)+0.5
        END IF
      ELSE IF(H.LE.PI*5./3.) THEN
        B=1.
        IF(H.LE.PI*4./3.) THEN
          G=-SIN(H-PI*7./6.)+0.5
        ELSE
          R= SIN(H-PI*9./6.)+0.5
        END IF
      ELSE
        R=1.
        IF(H.LE.PI*2.) THEN
          B=-SIN(H-PI*11./6.)+0.5
        ELSE
          G= SIN(H-PI*13./6.)+0.5
        END IF
      END IF
C     R=V*(1.-S*(1.-R))
C     G=V*(1.-S*(1.-G))
C     B=V*(1.-S*(1.-B))
      R=V-S*(1.-R)
      G=V-S*(1.-G)
      B=V-S*(1.-B)
C
      IF(R.LT.0.) THEN
C       PALLET-01
        CALL ERROR('PALLET-01: Red colour component negative')
      END IF
      IF(R.GT.1.) THEN
C       PALLET-02
        CALL ERROR('PALLET-02: Red colour component greater than 1')
      END IF
      IF(G.LT.0.) THEN
C       PALLET-03
        CALL ERROR('PALLET-03: Green colour component negative')
      END IF
      IF(G.GT.1.) THEN
C       PALLET-04
        CALL ERROR('PALLET-04: Green colour component greater than 1')
      END IF
      IF(B.LT.0.) THEN
C       PALLET-05
        CALL ERROR('PALLET-05: Blue colour component negative')
      END IF
      IF(B.GT.1.) THEN
C       PALLET-06
        CALL ERROR('PALLET-06: Blue colour component greater than 1')
      END IF
C
      RETURN
      END
C
C=======================================================================
C
      INCLUDE 'error.for'
C     error.for
C
C=======================================================================
C