      SUBROUTINE DFCLRS(NCLRS, CLRS, IPAT)

C     * MAR 11/2004 - M.BERKLEY (MODIFIED for NCAR V3.2)

C ************************************************************************
C
C  DESCRIPTION
C       THIS SUBROUTINE DEFINES THE GKS COLOUR PALETTES FOR THE COLOURS
C       USED BY HAFTON (FILLS PATTERNS 100-199).  IT MUST BE PASSED THE
C       NUMBER OF USER-DEFINED COLOURS AND AN ARRAY CONTAINING THE
C       COLOURS. IF NCLRS < 100, THE REST OF THE COLOURS ARE ASSIGNED
C       THEIR NORMAL DEFAULT VALUES.  THE DEFAULT COLOURS ARE AS FOLLOWS:
C
C        2 -> 37  COLOURS ON THE COLOUR WHEEL IN 10 DEGREE INCREMENTS
C       42 -> 51  SHADES OF GREY GOING FROM LIGHT TO DARK
C       52 -> 61     "   "  RED    "    "    "    "   "
C       62 -> 71     "   "  GREEN  "    "    "    "   "
C       72 -> 81     "   "  BLUE   "    "    "    "   "
C       82 -> 91     "   "  CYAN   "    "    "    "   "
C       92 -> 101    "   " MAGENTA "    "    "    "   "
C
C       THIS GIVES A TOTAL OF 96 COLOURS.
C
C  METHOD
C       ALL COLOURS ARE DEFINED USING THE HUE-SATURATION-VALUE METHOD
C       AND CONVERTED TO RGB VALUES USING 'HSVRGB'.  THESE VALUES ARE
C       THEN PASSED ON TO 'GSCR' WHICH DEFINES THE COLOUR OF THE PALETTE.
C       SINCE THE COLOUR INDEXES 0 AND 1 (BLACK AND WHITE RESPECTIVELY)
C       ARE USED TO DRAW THE BACKGROUND AND THE FOREGROUND, THE REDEFINED
C       PALETTES START AT 2.
C
C  ARGUMENTS
C       NCLRS - THE NUMBER OF USER-DEFINED COLOURS.
C               NOTE: NCLRS = 0 ; DEFAULT COLOUR PALETTE WILL BE USED
C                     NCLRS < 0 ; SHADING PATTERN CODES ARE EXPECTED
C                                 IN "IPAT" ARRAY.
C
C       CLRS - AN ARRAY OF DIMENSION (3, NCLRS) CONTAINING THE HSV
C              VALUES FOR THE PALETTE.
C
C       IPAT - AN ARRAY OF DIMENSION (-NCLRS) CONTAINING THE SHADING
C              PATTERN CODES. IT'S ONLY USED IF NCLRS.LT.0.
C
C  HISTORY
C       90/06/27  S. WILSON - CHANGE COLOUR PALETTES AND FORE/BACKGROUND.
C       90/11/30  S. WILSON
C       96/05/10  M. BERKLEY - REVISE TO ALLOW THE USER MORE CONTROL OVER
C                              THE NUMBER OF DEFINED COLOURS.
C
C *************************************************************************

      PARAMETER (MAXCLR = 171)

      INTEGER NCLRS, ID
      REAL ZCLRS(3, 2:MAXCLR), RED, GREEN, BLUE
      LOGICAL COLOUR

      INTEGER NPAT
      INTEGER IPAT(*)

      DIMENSION CLRS(3, 2:NCLRS+1)

      INTEGER NIPATS
      PARAMETER(NIPATS = 28)
      REAL SABR(NIPATS)
      COMMON /RGB/ SABR

      DATA (ZCLRS(1, I), I=38, 41) / 4*0.0 /
      DATA (ZCLRS(2, I), I=38, 41) / 4*0.0 /
      DATA (ZCLRS(3, I), I=38, 41) / 4*0.0 /

      LNCLRS=NCLRS
      IF(NCLRS.LT.0) THEN
         NPAT=-NCLRS
         LNCLRS=0
      ELSE
         NPAT=0
      ENDIF

C
C     * SET THE FOREGROUND COLOUR TO BLACK AND THE BACKGROUND COLOUR
C     * TO WHITE.
C
      CALL GSCR(1, 0, 1.0, 1.0, 1.0)
      CALL GSCR(1, 1, 0.0, 0.0, 0.0)

C
C     * DEFINE THE DEFAULT COLOURS, IN HUE, SATURATION AND VALUE.
C

C
C     * DEFINE THE FIRST 36 COLOURS - GO AROUND THE COLOUR WHEEL IN 10
C     * DEGREE INCREMENTS
C
      DO 100 I = 2, 37
           ZCLRS(1, I) = (I - 2)*10.0
           ZCLRS(2, I) = 1.0
           ZCLRS(3, I) = 1.0
  100 CONTINUE

C
C     * DEFINE COLOURS 42 TO 101.
C
      DO 110 I = 0, 9

C          * GREY SHADES
           ZCLRS(1, 42 + I) = 0.0
           ZCLRS(2, 42 + I) = 0.0

C          * RED SHADES (100)
           ZCLRS(1, 52 + I) = 0.0

C          * GREEN SHADES (112)
           ZCLRS(1, 62 + I) = 120.0

C          * BLUE SHADES (124)
           ZCLRS(1, 72 + I) = 240.0

C          * CYAN SHADES (118)
           ZCLRS(1, 82 + I) = 180.0

C          * MAGENTA SHADES (130)
           ZCLRS(1, 92 + I) = 300.0

C          * YELLOW SHADES (106)
           ZCLRS(1, 102 + I) = 60.0

C          * ORANGE SHADES (103)
           ZCLRS(1, 112 + I) = 30.0

C          * GREEN SHADES (109)
           ZCLRS(1, 122 + I) = 90.0

C          * TEAL SHADES (115)
           ZCLRS(1, 132 + I) = 150.0

C          * DARK BLUE SHADES (121)
           ZCLRS(1, 142 + I) = 210.0

C          * PURPLE SHADES (127)
           ZCLRS(1, 152 + I) = 270.0

C          * PINK SHADES (133)
           ZCLRS(1, 162 + I) = 320.0

  110 CONTINUE

C
C     * DEFINE THE BRIGHTNESS VALUES FOR THE GREY SHADES.
C
      DO 160 I = 42, 51
           ZCLRS(3, I) = 1.0 - (I - 42)*0.1
  160 CONTINUE


C
C     * DEFINE THE SATURATION AND BRIGHTNESS VALUES FOR THE FIRST 6
C     * SHADES OF EACH OF THE ABOVE COLOURS.
C
      DO 120 I = 52, 162, 10
           DO 130 J = 0, 5
                ZCLRS(2, I + J) = 1.0 - (5 - J)*0.15
                ZCLRS(3, I + J) = 1.0
  130      CONTINUE
  120 CONTINUE

C
C     * DEFINE THE SATURATION AND BRIGHTNESS VALUES FOR THE LAST 4
C     * SHADES IN EACH OF THE ABOVE COLOURS.
C
      DO 140 I = 57,167, 10
           DO 150 J = 1, 4
                ZCLRS(2, I + J) = 1.0
                ZCLRS(3, I + J) = 1.0 - J*0.125
  150      CONTINUE
  140 CONTINUE


C     * FORCE SOLID FILLS
      CALL GSFAIS(1)

C
C     * MAP THE COLOURS TO GKS PALETTES 2 TO 101.  THE FIRST 'LNCLRS'
C     * PALETTES MAY BE REDEFINED BY THE USER-DEFINED COLOURS.
C
      DO 200 I = 2, MAXCLR

C
C          * SET THE USER-DEFINED COLOURS
C
           IF (I - 1 .LE. LNCLRS) THEN
                ZCLRS(1, I) = CLRS(1, I)
                ZCLRS(2, I) = CLRS(2, I)
                ZCLRS(3, I) = CLRS(3, I)
 
                write(*,*) AMOD(CLRS(1, I), 360.0),
     1               MOD(CLRS(1, I), 360.0)
                CLRS(1, I) = AMOD(CLRS(1, I), 360.0)
                IF (CLRS(1, I) .LT. 0)
     1               ZCLRS(1, I) = CLRS(1, I) + 360.0

                IF (CLRS(2, I) .LT. 0 .OR. CLRS(2, I) .GT. 1.0)
     1               ZCLRS(2, I) = 1.0

                IF (CLRS(3, I) .LT. 0 .OR. CLRS(3, I) .GT. 1.0)
     1               ZCLRS(3, I) = 1.0
           ENDIF


  200 CONTINUE


C     * IF ALL THE COLOURS WERE DEFINED, THEN THE BLOATED GKS COLOUR
C     * MAP WOULD CAUSE THE USER TO QUICKLY RUN OUT OF COLOURS WITH
C     * IDT(ICTRANS).

C     * ALLOCATE THE USER SPECIFIED COLOURS IN THE GKS COLOUR MAP.

      IF(NPAT .EQ. 0) THEN
         DO I = 2,MAXCLR
            CALL HSVRGB(ZCLRS(1, I),
     1                  ZCLRS(2, I),
     2                  ZCLRS(3, I),
     3                  RED, GREEN, BLUE)
            CALL GSCR(1, I, RED, GREEN, BLUE)
CDEBUG
C!!!            WRITE(*,*) I,' Defining ',I,' AS ',RED,GREEN,BLUE
         ENDDO
      ELSE
CDEBUG
C!!!         WRITE(*,*) NPAT,(IPAT(I),I=1,NPAT)
         DO I = 1,NPAT
            IF((IPAT(I).GE.100).AND.(IPAT(I) .LE.199)) then
               CALL HSVRGB(ZCLRS(1, IPAT(I)-98),
     1              ZCLRS(2, IPAT(I)-98),
     2              ZCLRS(3, IPAT(I)-98),
     3              RED, GREEN, BLUE)
C               WRITE(6,*) 'COLOR ',I,IPAT(I),ZCLRS(1,IPAT(I)-98),
C     1                     ZCLRS(2, IPAT(I)-98),ZCLRS(3, IPAT(I)-98),
C     2                     RED,GREEN,BLUE
               IF(SABR(I).LT.0) THEN
                  RED   = (1.+SABR(I))*RED
                  GREEN = (1.+SABR(I))*GREEN
                  BLUE  = (1.+SABR(I))*BLUE
               ELSE
                  RED=SABR(I)*(1.-RED)+RED
                  GREEN=SABR(I)*(1.-GREEN)+GREEN
                  BLUE=SABR(I)*(1.-BLUE)+BLUE
               ENDIF
C               WRITE(6,*) 'RGB ', I,RED, GREEN, BLUE, SABR(I)
               IF(SABR(I).NE.0.) THEN
                  ID=419+I
               ELSE
                  ID = IPAT(I)-98
               ENDIF
               CALL GSCR(1, ID, RED, GREEN, BLUE)
C
            ELSEIF((IPAT(I).GE.350).AND.(IPAT(I).LE.420)) then
               CALL HSVRGB(ZCLRS(1, IPAT(I)-248),
     1              ZCLRS(2, IPAT(I)-248),
     2              ZCLRS(3, IPAT(I)-248),
     3              RED, GREEN, BLUE)
               CALL GSCR(1, IPAT(I)-248, RED, GREEN, BLUE)
CDEBUG
C!!!            WRITE(*,*) I,IPAT(I),IPAT(I)-98,
C!!!     1              '(',ZCLRS(1,IPAT(I)-98),
C!!!     2              ZCLRS(2,IPAT(I)-98),
C!!!     3              ZCLRS(3,IPAT(I)-98),')',
C!!!     4              RED,GREEN,BLUE
            ENDIF
         ENDDO
      ENDIF


C
C DONE.
C
      RETURN
C
      END
