      SUBROUTINE GGP_COLSHD(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)

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

      INTEGER I

      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 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,
     4                MAP)

C Contour-shade
      CALL GSLWSC(1.)
      CALL ARSCAM(IGGP_CPAREA,XWRK,YWRK,NWRK,IAREA,IGRP,
     1        NOGRPS,GGP_PATTERN)
      CALL CPSETI('LBC',0)
      IF (PATPLT) THEN
        CALL CPSETI('LLB',0)
        CALL CPSETI('HLB',0)
      ENDIF
      CALL GSLWSC(1.5)

      RETURN
      END
