
C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C***************************
C**  LSC_COLOURS    **
C***************************
C
C **** LSC SERVICE ROUTINE ONLY ****
C
      SUBROUTINE LSC_COLOURS (IRED, IGREEN, IBLUE)
C
C Purpose: Get 64 colour colourscale for false coloured absorption
C          surface images (colour 64 black)
C
C          blue...green...yellow...orange...red (low...high)
C
C Author:  John W. Campbell, December 1993
C
C Arguments:
C
      INTEGER IRED(64)
      INTEGER IGREEN(64)
      INTEGER IBLUE(64)

C   IRED   (W)   Red components for the 64 colours (0-65535)
C   IGREEN (W)   Green components for the 64 colours (0-65535)
C   IBLUE  (W)   Blue components for the 64 colours (0-65535)

C
C====== FUNCTION TYPES:
C

C
C====== LOCALS:
C
      INTEGER I
      INTEGER ICOLR
      INTEGER IV
      REAL H
      REAL S
      REAL V
      REAL R
      REAL G
      REAL B
      REAL TH
      REAL P1
      REAL P2
      REAL P3
      REAL FR

C     INTEGER I        !Temp variable
C     INTEGER ICOLR    !Colours loop variable
C     INTEGER IV       !Integer value
C     REAL H           !Hue 0-1.0
C     REAL S           !Saturation 0-1.0
C     REAL V           !Value 0-1.0
C     REAL R           !Red component 0-1.0
C     REAL G           !Green component 0-1.0
C     REAL B           !Blue component
C     REAL TH          !Hue angle
C     REAL P1          !Temp variable
C     REAL P2          !Temp variable
C     REAL P3          !Temp variable
C     REAL FR          !Fraction
C
C-------------------------------------------------------------------------------
C
C====== Loop through the 63 colours
C
      DO 100 ICOLR = 1, 63
         TH = 3.14159*(ICOLR-1)/62.0
         H = 240.0*(1.0-COS(TH))/2.0
         S = 1.0
         V = 1.0
C
C====== Convert to RGB
C         
         IF (H.EQ.360.0) H = 0.0
         H = H/60.0
         IV = FLOAT(INT(H))
         FR = H - IV
         P1 = V * (1.0-S)
         P2 = V * (1.0 - (S*FR))
         P3 = V * (1.0 - (S * (1.0-FR)))
         I = INT(IV)
         IF (I.EQ.0) THEN
            R = V
            G = P3
            B = P1
         ELSE IF (I.EQ.1) THEN
            R = P2
            G = V
            B = P1
         ELSE IF (I.EQ.2) THEN
            R = P1
            G = V
            B = P3
         ELSE IF (I.EQ.3) THEN
            R = P1
            G = P2
            B = V
         ELSE IF (I.EQ.4) THEN
            R = P3
            G = P1
            B = V
         ELSE IF (I.EQ.5) THEN
            R = V
            G = P1
            B = P2
         END IF
C
C====== Store RGB colour components
C
         IRED(64-ICOLR) = 65535*R
         IGREEN(64-ICOLR) = 65535*G
         IBLUE(64-ICOLR) = 65535*B
100    CONTINUE
       IRED(64) = 0    
       IGREEN(64) = 0
       IBLUE(64) = 0

       RETURN

       END
