      SUBROUTINE GGP_COLCON(ZREG, MREG, NREG, NCL,
     1                      PROJ, RWRK, LRWK, IWRK, LIWK,
     2                      FLOW, FHIGH, FINC, SCAL,
     3                      NSET, LHI, ICOSH,
     4                      PUB, SECOND,
     5                      NZERO, SPVAL, SUBAREA,
     6                      POSDASHPAT,NEGDASHPAT,
     7                      MAP)

C     * Apr 01/05 - F.MAJAESS (Make "FINCN/NCLTMP" resetting 
C     *                        "IARBI" dependent.)
C     * MAR 11/2004 - M.BERKLEY (MODIFIED for CCCMA)

C      IMPLICIT NONE
C COLour CONtour plotting routine - drawing contour lines and labels
C with or without zero contour line.

      INTEGER NWRK, NOGRPS
      PARAMETER (NWRK=30000,NOGRPS=5)
      INTEGER IGGP_CPAREA_SIZE
      PARAMETER (IGGP_CPAREA_SIZE=4000000)
      INTEGER NIPATS
      PARAMETER (NIPATS = 28)

      INTEGER MREG, NREG
      REAL ZREG(MREG, NREG)
      INTEGER NCL
      CHARACTER*(*) PROJ
      INTEGER LRWK, LIWK
      REAL RWRK(LRWK)
      INTEGER IWRK(LIWK)
      REAL FLOW, FHIGH, FINC
      INTEGER NSET
      INTEGER LHI
      INTEGER ICOSH
      LOGICAL PUB
      LOGICAL SECOND
      LOGICAL NZERO
      REAL SPVAL
      LOGICAL SUBAREA
      CHARACTER*(*) POSDASHPAT,NEGDASHPAT
      LOGICAL MAP

      REAL XWRK(NWRK), YWRK(NWRK)

      INTEGER IGGP_CPAREA(IGGP_CPAREA_SIZE)
      COMMON /GGP_AREA/IGGP_CPAREA

C Publication common block
      LOGICAL CPUB, DOTITLE, DOINFOLABEL, DOLGND, DOLABEL, SHAD
      COMMON /PPPP/ CPUB, SHAD, DOTITLE, DOINFOLABEL, DOLGND, DOLABEL

      INTEGER INZERO
      INTEGER CLU_VALUE
      INTEGER NCLTMP
      INTEGER I,J
      REAL CLVTMP,TOL,ZMN,ZMX,TOLD
      INTEGER IDPU
      CHARACTER*32 CCLD
      CHARACTER*10 LLTXT
      INTEGER LSTRBEG,LSTREND
      EXTERNAL LSTRBEG,LSTREND

      REAL FLOWN, FHIGHN, FINCN, SCAL
      INTEGER STRLN

      EXTERNAL GGP_PATTERN
      EXTERNAL CPDRPL
      REAL R1MACH
      EXTERNAL R1MACH
C     ARBITRARY LINE CONTOURS
      INTEGER NPATS,IARBI
      REAL ZLEVS(NIPATS), CWM
      COMMON /ARBI/ ZLEVS,NPATS,IARBI, CWM
      INTEGER IZ,IC,IZLEV
      REAL RZLEV,DIF
      REAL XMAPMN,XMAPMX,YMAPMN,YMAPMX,DUM1,DUM2,DUM3,DUM4,DIFX
      INTEGER IDUM

C      PARAMETER (DASHPATSOL='$$$$')
C      PARAMETER (DASHPATDASH='$''$''')
C
C      NEGDASHPAT=DASHPATDASH
C      POSDASHPAT=DASHPATSOL
C
      TOL=R1MACH(3)
      TOL=1.D-6
      TOLA=5.D-6
      IZ=0
      CALL GETSET(XMAPMN, XMAPMX, YMAPMN, YMAPMX,
     1            DUM1,DUM2,DUM3,DUM4,IDUM)

      DIFX=XMAPMX-XMAPMN

      IF(DIFX.LT.0.80.AND.CWM.EQ.1.0) THEN
         CWM=0.80/DIFX
      ENDIF

      CALL CPSETR ('CWM', CWM)
C
      IF(IARBI.GT.0) THEN
         FHIGHN=ZLEVS(1)
         DO I=1,NPATS-2
            FHIGHN=AMAX1(FHIGHN,ZLEVS(I+1),ZLEVS(I+2))
         ENDDO
         FLOWN=ZLEVS(1)
         DO I=1,NPATS-2
            FLOWN=AMIN1(FLOWN,ZLEVS(I+1),ZLEVS(I+2))
         ENDDO
         FINCN=ABS((FHIGHN-FLOWN)/NPATS)
         NCLTMP=NPATS
C
      ELSE
C Adjust user-given bounds if needed
         CALL GGP_HILO(ZREG, MREG, NREG, FLOW, FHIGH,
     1        FINC, FLOWN, FHIGHN, SPVAL)
      ENDIF
C Select contour levels
      CALL GGP_CONLS(FLOWN, FHIGHN, FINC)

C Determine whether highs, lows and data points are to be labelled.
      CALL GGP_CONHLD(LHI, ZREG, MREG, NREG, PROJ,
     1     FLOWN, FHIGHN, FINC)

C Define necessary contour parameters.
      CALL GGP_CPCPRP(ZREG, MREG, NREG,
     1     PROJ, RWRK, LRWK, IWRK, LIWK,
     2     FLOWN, FHIGHN, FINC, .TRUE.,
     3     PUB, NZERO, SPVAL, SUBAREA,
     4     MAP)

C Define the information label at the bottom of the plot.
      CALL GGP_ILDEF(ZREG, MREG, NREG, PROJ, SCAL, SUBAREA)

      IF(IARBI.LE.0) THEN
       CALL CPGETR('CIU - CONTOUR INTERVAL USED', FINCN)
       CALL CPGETI('NCL - NUMBER OF CONTOUR LEVELS', NCLTMP)
      ENDIF

C!!!         WRITE(*,*)'+',NEGDASHPAT,'+'
C!!!         WRITE(*,*)'+',POSDASHPAT,'+'
C Set dashed lines

C     Dashes are too short if the resolution is too fine.
      IF((MREG*NREG).GT.10000) THEN
         CALL CPSETR('DPV - Dash Pattern Vector Length',0.003)
      ENDIF

      INZERO=-100
      IZ=0

      DO I = 1, NCLTMP
         CALL CPSETI('PAI - PARAMETER ARRAY INDEX', I)
         CALL CPGETR('CLV - CONTOUR LEVEL VALUES', CLVTMP)
         IF(NZERO .AND. (ABS(CLVTMP) .LT. TOL)) THEN
CDEBUG
C!!!C     WRITE(*,91) I,ILEV,CLVTMP
C!!! 91         FORMAT('CONLS: ',I3,' ZERO    clv(',I3,'): ',E10.4)
CDEBUG
            INZERO=I
         ENDIF

C Use TOL to protect against dashed zero lines.
         CALL CPSETI('PAI - PARAMETER ARRAY INDEX', I)
C!!!         CALL CPGETI('DPU', IDPU)
C!!!         CALL CPSETI('DPU', -IDPU)
         IF(CLVTMP.LE.-TOL) THEN
            CALL CPSETC('CLD', NEGDASHPAT)
         ELSE
            CALL CPSETC('CLD', POSDASHPAT)
         ENDIF
CDEBUG
C!!!C     WRITE(*,90) I,CLVTMP
C!!! 90      FORMAT('CONLS: ',I3,' Setting clv(',I3,'): ',E10.4)
CDEBUG
C         IC=0
C         DO J=1,4
C            RZLEV=CLVTMP*(10.**(J-1))
C            IZLEV=INT(RZLEV)
C            DIF=RZLEV-IZLEV
C            TOLD=TOL*(10.**(J-1))
C            IF(((DIF.EQ.0.).OR.(ABS(DIF).LE.TOLD)).AND.(IC.NE.1)) THEN
C               IC=1
C               IF((J).GT.IZ) IZ=J-1
C            ENDIF
C         ENDDO
      ENDDO
C
C Set thick/thin lines based on even FINCN intervals from 0
C
      DO I=1,NCLTMP
         CALL CPSETI('PAI - PARAMETER ARRAY INDEX', I)
         CALL CPGETR('CLV - CONTOUR LEVEL VALUES', CLVTMP)
         IF((MOD(NINT((CLVTMP-FLOWN)/FINCN),2).EQ.0).OR.
     1        (ABS(CLVTMP).LT.TOL).OR.(IARBI.GT.0)) THEN
            CALL CPSETI('CLU', 3)
            IF (PUB) THEN
               CALL CPSETR('CLL - CONTOUR LINE LINE WIDTH',3.0)
            ELSE
               CALL CPSETR('CLL - CONTOUR LINE LINE WIDTH',2.0)
            ENDIF
CDEBUG
C!!!            WRITE(*,*)'THICK at ',CLVTMP,I,
C!!!     1           TOL,
C!!!     2           MOD(CLVTMP,FINC),
C!!!     3           INT(MOD(CLVTMP,FINC)),
C!!!     4           MOD(INT(MOD(CLVTMP,FINC)),2)
CDEBUG
C
C           SELECT THE PROPER FORMAT FOR LABEL
C
              IZZ=0
              FLVAL=CLVTMP
              IF(FLVAL.EQ.0.0.OR.
     1             (FLVAL.GE.-TOL.AND.FLVAL.LE.TOL)) THEN
                 WRITE(LLTXT,2002)
              ELSEIF(ABS(FLVAL).GT.9999..OR.ABS(FLVAL).LT.0.001) 
     1                THEN
                 WRITE(LLTXT,2000) FLVAL            
              ELSE
                 FVAL=ABS(1.0D0*FLVAL)+1.D0*TOLA
                 FREST=10.D0*(1.D0*FVAL-AINT(1.D0*FVAL))
                 DO J=1,3
                    IFINT=AINT(FREST)
                    IF(IFINT.GT.0) IZZ=J
                    FREST=(10.D0*(1.D0*FREST-AINT(1.D0*FREST)))
                 ENDDO
                 IF(IZZ.EQ.0) THEN
                    IF(FLVAL.LT.0.) THEN
                       IFLVAL=AINT(FLVAL-TOLA)
                    ELSE
                       IFLVAL=AINT(FLVAL+TOLA)
                    ENDIF
                    WRITE(LLTXT,992) IFLVAL
                 ELSEIF(IZZ.EQ.1) THEN
                    WRITE(LLTXT,2030) FLVAL
                 ELSEIF(IZZ.EQ.2) THEN
                    WRITE(LLTXT,2031) FLVAL
                 ELSEIF(IZZ.EQ.3) THEN
                    WRITE(LLTXT,2032) FLVAL
                 ELSE
                    WRITE(LLTXT,2000) FLVAL
                 ENDIF
              ENDIF

C            IF(CLVTMP.EQ.0.0.OR.(CLVTMP.GE.-TOL.AND.CLVTMP.LE.TOL)) THEN
C               WRITE(LLTXT,2002)
C            ELSEIF(ABS(CLVTMP).GT.9999..OR.ABS(CLVTMP).LT.0.001) 
C     1              THEN
C               WRITE(LLTXT,2000) CLVTMP
C            ELSEIF(IZ.EQ.1) THEN
C               WRITE(LLTXT,2030) CLVTMP
C            ELSEIF(IZ.EQ.2) THEN
C               WRITE(LLTXT,2031) CLVTMP
C            ELSEIF(IZ.EQ.3) THEN
C               WRITE(LLTXT,2032) CLVTMP
C            ELSE
C               WRITE(LLTXT,2000) CLVTMP
C            ENDIF
C
            CALL CPSETC('LLT - LINE LABEL TEXT STRING',
     1           LLTXT(LSTRBEG(LLTXT):LSTREND(LLTXT)))
         ELSE
            CALL CPSETI('CLU', 1)
            IF (PUB) THEN
               CALL CPSETR('CLL - CONTOUR LINE LINE WIDTH',3.0)
            ELSE
               CALL CPSETR('CLL - CONTOUR LINE LINE WIDTH',1.0)
            ENDIF
CDEBUG
C!!!            WRITE(*,*)'THIN at ',CLVTMP,I,
C!!!     1           TOL,
C!!!     2           MOD(CLVTMP,FINC),
C!!!     3           INT(MOD(CLVTMP,FINC)),
C!!!     4           MOD(INT(MOD(CLVTMP,FINC)),2)
CDEBUG
         ENDIF
         IF(.NOT.DOLABEL) THEN
            CALL CPSETI('CLU',1)
         ENDIF
      ENDDO

      CALL CPSETI('PAI',-2)
      CALL CPSETI('CLU',0)
      IF (INZERO .GT. 0) THEN
         CALL CPSETI('PAI - PARAMETER ARRAY INDEX', INZERO)
         CALL CPSETI('CLU', 0)
      ENDIF

C Draw contours and geographic map.

C For some reason, if the plot was a subarea, the contours were always
C labelled. So I added a condition around the two calls that plot the
C labels. RT

      IF (DOLABEL) THEN
         CALL CPLBAM(ZREG, RWRK, IWRK, IGGP_CPAREA)
      ENDIF
      CALL CPCLDM(ZREG,RWRK,IWRK,IGGP_CPAREA,CPDRPL)
      IF (DOLABEL) THEN
         CALL CPLBDR(ZREG,RWRK,IWRK)
      ENDIF

  991 FORMAT(G7.2)
  992 FORMAT(I7)
  993 FORMAT(F6.1)
  994 FORMAT(F7.2)
 2000 FORMAT(1P1E10.1)
 2001 FORMAT(F6.2)
 2002 FORMAT('0')
 2030 FORMAT(F6.1)
 2031 FORMAT(F7.2)
 2032 FORMAT(F8.3)
      RETURN
      END
