      SUBROUTINE GGP_COLSMSHD(ZREG, MREG, NREG, NCL, 
     1                      PROJ, RWRK, LRWK, IWRK, LIWK,
     2                      FLOWN, FHIGHN, FINC,
     3                      NSET, LHI,  
     4                      PUB, CLRPLT, PATPLT, SPVAL, SUBAREA,
     5                      MAP,
     6                      RLATMN,RLATMX,RLONMN,RLONMX,
     7                      BZREG)

C     * MAR 11/2004 - M.BERKLEY (MODIFIED for CCCMA)

      IMPLICIT NONE
C COLour CONtour plotting routine - colored and non-colored shading.

      INTEGER MREG, NREG
      REAL ZREG(MREG, NREG)
      INTEGER NCL
      CHARACTER*(*) PROJ
      INTEGER LRWK, LIWK
      REAL RWRK(LRWK)
      INTEGER IWRK(LIWK)
      REAL FLOWN, FHIGHN, FINC
      INTEGER NSET
      INTEGER LHI
      LOGICAL PUB
      LOGICAL CLRPLT, PATPLT
      REAL SPVAL
      LOGICAL SUBAREA
      LOGICAL MAP
      REAL RLATMN(2),RLATMX(2),RLONMN(2),RLONMX(2),DGRW

      INTEGER I,J,K,L
      INTEGER I1,I2

      REAL ZCURR(3)
      REAL RED, GREEN, BLUE

      INTEGER NWRK, NOGRPS
      PARAMETER (NWRK=30000,NOGRPS=5)
      REAL XWRK(NWRK), YWRK(NWRK)
      INTEGER IAREA(NOGRPS), IGRP(NOGRPS)

      INTEGER IGGP_CPAREA_SIZE 
      PARAMETER (IGGP_CPAREA_SIZE=4000000)
      INTEGER IGGP_CPAREA(IGGP_CPAREA_SIZE)
      COMMON /GGP_AREA/IGGP_CPAREA

      INTEGER NIPAT,NPAT,MAXPAT,MAXCLRS
      PARAMETER(NIPAT = 28)
      INTEGER IPAT(NIPAT)
      REAL ZLEV(NIPAT)
      COMMON /FILLCB/ IPAT,ZLEV,NPAT,MAXPAT,MAXCLRS
      EXTERNAL GGP_PATTERN
      EXTERNAL CPDRPL 

C LOW, HIGH, RANGE FOR SMOOTH IMAGE
      REAL FILOW,FIHIGH,FIRANGE

C     BYTE ARRAY FOR IMAGE
      INTEGER BZREG(MREG,NREG)

C Define contour levels for shading 
      CALL CONTDF(PUB)

C Define necessary parameters.

C      CALL CPSETR('CIS - CONTOUR INTERVAL SPECIFIER', FINC)
C      CALL CPSETR('CMN - MINIMUM CONTOUR LEVEL', FLOWN)
C      CALL CPSETR('CMX - MAXIMUM CONTOUR LEVEL', FHIGHN)
      CALL GGP_CPCPRP(ZREG, MREG, NREG, 
     1                PROJ, RWRK, LRWK, IWRK, LIWK,
     2                FLOWN, FHIGHN, FINC, .FALSE.,
     3                PUB, .TRUE., SPVAL, SUBAREA, MAP)

      DO I=1,MREG
         DO J=1,NREG
            IF(ZREG(I,J).LT.ZLEV(1)) THEN
               BZREG(I,J)=2
CDEBUG
C!!! 901           FORMAT(A4,1X,2(I4,1X),5X,I4,1X,2(F7.3,1X))
C!!!               WRITE(*,901)'SMALL',I,J,BZREG(I,J),
C!!!     1              ZREG(I,J),ZLEV(1)
            ELSE IF(ZREG(I,J).GE.ZLEV(NPAT)) THEN
               BZREG(I,J)=(100/NPAT)*(NPAT-1)+2
CDEBUG
C!!! 902           FORMAT(A4,1X,2(I4,1X),5X,I4,1X,2(F7.3,1X))
C!!!               WRITE(*,902)'BIG  ',I,J,BZREG(I,J),
C!!!     1              ZREG(I,J),ZLEV(NPAT)
            ELSE
               DO K=1,NPAT-1
                  IF(ZREG(I,J).GE.ZLEV(K)
     1                 .AND.ZREG(I,J).LT.ZLEV(K+1)) THEN
                     BZREG(I,J)=(ZREG(I,J)-ZLEV(K))
     1                    /(ZLEV(K+1)-ZLEV(K))*(100/NPAT)
     2                    +(K-1)*(100/NPAT)+2
CDEBUG
C!!! 903                 FORMAT(A4,1X,4(I4,1X),3(F7.3,1X))
C!!!                     WRITE(*,903)'NORM',I,J,K,BZREG(I,J),
C!!!     1                    ZREG(I,J),ZLEV(K),ZLEV(K+1)
                  ENDIF
               ENDDO
            ENDIF
CDEBUG
C!!!            CALL GQCR(1,BZREG(I,J),0,L,RED,GREEN,BLUE)
C!!!            CALL RGBHSV(RED,GREEN,BLUE,ZCURR(1),ZCURR(2),ZCURR(3))
C!!! 90         FORMAT(I4,1X,A1,1X,3(F7.3,1X),A3,3(F7.3,1X),A1)
C!!!            WRITE(*,90)BZREG(I,J),
C!!!     1           '(',ZCURR,') (',RED,GREEN,BLUE,')'
         ENDDO
      ENDDO
           
      CALL GCA (RLONMN(1),RLATMN(1),RLONMX(1),RLATMX(1),
     1     MREG,NREG,1,1,MREG,NREG,BZREG)

      RETURN
      END
