C
C Program PALLET to interpolate colour tables.
C
C Version: 5.30
C Date: 1999, February 26
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  FACTOR,A1,H1,S1,V1,A2,H2,S2,V2,R2,G2,B2,H,S,V,R,G,B
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.0.5) THEN
            IF(H1+H2.LT.1.) THEN
              IF(H1.LT.H2) THEN
                H=H+A1
              ELSE
                H=H+A2
              END IF
            ELSE
              IF(H1.GE.H2) THEN
                H=H-A1
              ELSE
                H=H-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=1/3, blue=2/3.
C     S...    Saturation or chroma: saturation*value=chroma=pure colour.
C     V...    Value = pure colour + white.
C
C No subroutines and external functions referred.
C
C Date: 1999, February 26
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=11./12.-ASIN((B-G)/S-0.5)/2./PI
            H=(6.-(B-G)/S)/6.
          END IF
        ELSE
          S=(V-B)
          IF(S.GT.0.) THEN
*           H= 1./12.+ASIN((G-B)/S-0.5)/2./PI
            H=(0.+(G-B)/S)/6.
          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= 3./12.-ASIN((R-B)/S-0.5)/2./PI
            H=(2.-(R-B)/S)/6.
          END IF
        ELSE
          S=(V-R)
          IF(S.GT.0.) THEN
*           H= 5./12.+ASIN((B-R)/S-0.5)/2./PI
            H=(2.+(B-R)/S)/6.
          END IF
        END IF
      ELSE
        V=B
        IF(G.GE.R) THEN
          S=(V-R)
          IF(S.GT.0.) THEN
*           H= 7./12.-ASIN((G-R)/S-0.5)/2./PI
            H=(4.-(G-R)/S)/6.
          END IF
        ELSE
          S=(V-G)
          IF(S.GT.0.) THEN
*           H= 9./12.+ASIN((R-G)/S-0.5)/2./PI
            H=(4.+(R-G)/S)/6.
          END IF
        END IF
      END IF
      IF(H.LT.0.) THEN
        H=H+1.
      END IF
      IF(H.GT.1.) THEN
        H=H-1.
      END IF
C     If V is saturation (comment if V is chroma):
*     IF(V.GT.0.) THEN
*       S=S/V
*     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=1/3, blue=2/3.
C     S...    Saturation or chroma: saturation*value=chroma=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: 1999, February 26
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.1./6.) THEN
        R=1.
        IF(H.LE.0.) THEN
*         B=-SIN(2.*PI*(H+1./12.))+0.5
          B=-6.*H
        ELSE
*         G= SIN(2.*PI*(H-1./12.))+0.5
          G= 6.*H
        END IF
      ELSE IF(H.LE.3./6.) THEN
        G=1.
        IF(H.LE.2./6.) THEN
*         R=-SIN(2.*PI*(H-3./12.))+0.5
          R=-6.*H+2.
        ELSE
*         B= SIN(2.*PI*(H-5./12.))+0.5
          B= 6.*H-2.
        END IF
      ELSE IF(H.LE.5./6.) THEN
        B=1.
        IF(H.LE.4./6.) THEN
*         G=-SIN(2.*PI*(H-7./12.))+0.5
          G=-6.*H+4.
        ELSE
*         R= SIN(2.*PI*(H-9./12.))+0.5
          R= 6.*H-4.
        END IF
      ELSE
        R=1.
        IF(H.LE.1.) THEN
*         B=-SIN(2.*PI*(H-11./12.))+0.5
          B=-6.*H+6.
        ELSE
*         G= SIN(2.*PI*(H-13./12.))+0.5
          G= 6.*H-6.
        END IF
      END IF
C     If V is saturation:
*     R=V*(1.-S*(1.-R))
*     G=V*(1.-S*(1.-G))
*     B=V*(1.-S*(1.-B))
C     If V is chroma:
      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