      SUBROUTINE GGP_LEGEND(PROJ,CLRPLT,PATPLT,ILOG10)

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

C      IMPLICIT NONE
C LEGEND-plotting routine.
      CHARACTER*(2) PROJ
      LOGICAL CLRPLT,PATPLT
      EXTERNAL LBFILL

      REAL XMAPMN,XMAPMX,YMAPMN,YMAPMX,DUM1,DUM2,DUM3,DUM4
      INTEGER NCLL
      INTEGER IDUM
      REAL XBARMN, XBARMX, YBARMN, YBARMX, BOXWDT, XPER, YPER
      INTEGER I
      REAL CLV
      INTEGER NLBLS
      PARAMETER(NLBLS = 35)
      CHARACTER*10 LBLS(NLBLS),TLBL

C For passing colour index array into colour FILL routines through
C Common Block.
      INTEGER NIPAT, NPAT, MAXPAT, MAXCLRS
      PARAMETER(NIPAT = 28)
      INTEGER IPAT(NIPAT)
      REAL ZLEV(NIPAT)
      COMMON /FILLCB/ IPAT, ZLEV, NPAT, MAXPAT, MAXCLRS

      INTEGER LFIN(NIPAT)
      REAL CHSIZE
      INTEGER LSTRBEG,LSTREND
      EXTERNAL LSTRBEG,LSTREND

C FOR LOGARITHMIC BASE 10 PLOTS
      INTEGER ILOG10
C     HI LO COMMON BLOCK FOR HI AND LOW
      INTEGER ILOG
      REAL OFFSET
      COMMON /HILO/ ILOG, OFFSET
C
      REAL SABR(NIPAT)
      COMMON /RGB/ SABR
      REAL MIDX,MIDY
C
CDEBUG
C!!!      PRINT*, "LEGEND"

C Get the number of boundaries for shading
      CALL CPGETI('NCL - NUMBER OF CONTOUR LEVELS', NCLL)
C!!!      PRINT*, NCLL

C Use Duplex font.
      CALL PCSETI('CD - COMPLEX OR DUPLEX DATASET', 1)
      CALL PCSETI('FN - FONT NUMBER OR NAME', 0)
      CALL LBSETR('WLB - WIDTH OF LABEL LINES',2.5)

C Finish defining the label bar parameters.
      CALL GETSET(XMAPMN, XMAPMX, YMAPMN, YMAPMX,
     1            DUM1,DUM2,DUM3,DUM4,IDUM)
C
      XPER=0.50
      YPER=0.35
C
      IF(PROJ.EQ.'ST') THEN
C       BAR WILL BE ON RIGTH HAND SIDE AND VERTICAL
C        XBARMX = XMAPMX + 0.14
C        XBARMN = XMAPMX + 0.01
C       HORIZONTAL WIDHT OF LEGEND BAR
        XBARMX = XMAPMX + 0.14
        XBARMN = XMAPMX + 0.04
C       VERTICAL LENGTH OF LEGEND BAR
        IF (NPAT .LE. 8) THEN
C          YBARMN = YMAPMN + 0.05
C          YBARMX = YMAPMN + 0.55
          MIDY = (YMAPMX - YMAPMN)/2. + YMAPMN
          BOXWDT = (YMAPMX - YMAPMN)/MAX(NPAT,7)
          YBARMN = MIDY - (FLOAT(NPAT)/2.)*BOXWDT
          YBARMX = MIDY + (FLOAT(NPAT)/2.)*BOXWDT
C          YBARMN = YMAPMN
C          YBARMX = YMAPMX
        ELSE
          YBARMN = YMAPMN
          YBARMX = YMAPMX
        ENDIF
C        BOXWDT = (YBARMX - YBARMN)/MAX(NPAT,7)
CCCCCCCCCCCCCCCCCCCC
C   USE ABSOLUTE NUMBERS FOR ST LABELS
C        XBARMN = 0.87
C        XBARMX = 0.99
C        YBARMN = 0.2
C        IF(NPAT.LE.7) THEN
C           YBARMX = YBARMN+NPAT*0.07
C        ELSE
C           YBARMX = YBARMN+NPAT*0.035
C        ENDIF
CCCCCCCCCCCCCCCCCCCC
      ELSE
C       BAR WILL BE BELOW GRAPHIC AND HORIZONTAL
C       HORIZONTAL LENGTH OF LEGEND BAR
        IF (NPAT .LE. 8) THEN
C          XBARMN = XMAPMN + 0.05
C          XBARMX = XMAPMX - 0.2
          MIDX = (XMAPMX - XMAPMN)/2. + XMAPMN
          BOXWDT = (XMAPMX - XMAPMN)/MAX(NPAT,7)
          XBARMN = MIDX - (FLOAT(NPAT)/2.)*BOXWDT
          XBARMX = MIDX + (FLOAT(NPAT)/2.)*BOXWDT
        ELSE
          XBARMN = XMAPMN
          XBARMX = XMAPMX
        ENDIF
C       VERTICAL WIDTH OF LEGEND BAR
        YBARMN = YMAPMN-0.10
        YBARMX = YMAPMN-0.04
        
CCCCCCCCCCCCCCCCCCCC
C   USE ABSOLUTE NUMBERS FOR CE LABELS
C        XBARMN = 0.06
C        IF(NPAT.LE.7) THEN
C           XBARMX = XBARMN+NPAT*0.1
C        ELSE
C           XBARMX = XBARMN+NPAT*0.065
C        ENDIF
C        YBARMN = 0.16
C        YBARMX = 0.22
C   On SGI, YBARMX should be 0.21.  Could not find a single number which
C   produced the same sized letters on both AIX and SGI.
C       YBARMX = 0.22
CCCCCCCCCCCCCCCCCCCC
      ENDIF
C      IF (NPAT .GT. 9) RETURN
C Define the contour level numeric labels.
      TOL=1.D-6
      TOLA=5.D-6
      DO I = 1, NCLL
         CALL CPSETI('PAI - PARAMETER ARRAY INDEX', I)
         CALL CPGETR('CLV - CONTOUR LEVEL VALUES', CLV)
         IZZ=0
         FLVAL=CLV
         IF(FLVAL.EQ.0.0.OR.
     1        (FLVAL.GE.-TOL.AND.FLVAL.LE.TOL)) THEN
            WRITE(TLBL,2002)
         ELSEIF(ABS(FLVAL).GT.9999..OR.ABS(FLVAL).LT.0.001) 
     1           THEN
            WRITE(TLBL,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(TLBL,992) IFLVAL
            ELSEIF(IZZ.EQ.1) THEN
               WRITE(TLBL,2030) FLVAL
            ELSEIF(IZZ.EQ.2) THEN
               WRITE(TLBL,2031) FLVAL
            ELSEIF(IZZ.EQ.3) THEN
               WRITE(TLBL,2032) FLVAL
            ELSE
               WRITE(TLBL,2000) FLVAL
            ENDIF
         ENDIF





C         IC=0
C        MAXIMUM OF 3 NUMBERS AFTER THE POINT
C         DO J=1,4
C            RZLEV=CLV*(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
C      ENDDO
C      DO I=1,NCLL
C         CALL CPSETI('PAI - PARAMETER ARRAY INDEX', I)
C         CALL CPGETR('CLV - CONTOUR LEVEL VALUES', CLV)
C
C         IF(CLV.EQ.0.0.OR.(CLV.GE.-TOL.AND.CLV.LE.TOL)) THEN
C            WRITE(TLBL,2002)
C         ELSEIF(ABS(CLV).GT.9999..OR.ABS(CLV).LT.0.001) 
C     1           THEN
C            WRITE(TLBL,2000) CLV
C         ELSEIF(IZ.EQ.1) THEN
C               WRITE(TLBL,2030) CLV
C         ELSEIF(IZ.EQ.2) THEN
C               WRITE(TLBL,2031) CLV
C         ELSEIF(IZ.EQ.3) THEN
C               WRITE(TLBL,2032) CLV
C         ELSE
C               WRITE(TLBL,2001) CLV
C         ENDIF
         LBLS(I)=TLBL(LSTRBEG(TLBL):LSTREND(TLBL))
      ENDDO
C

C      DO 10 I = 1, NCLL
C         IF(ILOG10.EQ.1.AND.OFFSET.EQ.0.) THEN
C            CLV=10.**CLV
C         ELSEIF(ILOG10.EQ.1) THEN
C            IF(CLV.GE.0.) THEN
C               CLV=10.**(CLV-OFFSET)
C            ELSE
C               CLV=-10.**(-CLV-OFFSET)
C            ENDIF
C         ENDIF
C         IF((ABS(CLV).LT.10000 .AND.
C     1        ABS(CLV).GE.0.01)) THEN
C            WRITE (TLBL, '(F8.2)') CLV
C         ELSEIF(CLV.EQ.0.0) THEN
C            WRITE (TLBL, 1000) 
C         ELSE
C            WRITE (TLBL, '(E8.2)') CLV
C         ENDIF
C         LBLS(I)=TLBL(LSTRBEG(TLBL):LSTREND(TLBL))
CDEBUG
C 10   CONTINUE

C Might be able to collapse the next statement and have smaller decisions
C instead for CLRPLT related stuff.
      IF (.NOT. PATPLT) THEN
C Drawing colour shading patterns in legend boxes
         DO 20 I = 1, NPAT
            IF (IPAT(I).GE.100 .AND. IPAT(I).LE.199) THEN
               IF(SABR(I).NE.0.) THEN
                  LFIN(I) = 419 + I
               ELSE
                  LFIN(I) = IPAT(I) - 98
               ENDIF
            ELSEIF (IPAT(I).GE.350 .AND. IPAT(I).LE.420) THEN
               LFIN(I) = IPAT(I) - 248
            ENDIF
 20      CONTINUE
         IF(PROJ.EQ.'ST') THEN
            CALL LBSETR('WLB',3.)
            CALL LBLBAR(1, XBARMN, XBARMX, YBARMN, YBARMX,
     1           NCLL, YPER, 1., LFIN, 0,
     2           LBLS, NCLL-1, 1)
CC            CALL LBLBAR(1, XBARMN, XBARMX, YBARMN, YBARMX,
CC     1           NCLL, .4, .45, LFIN, 0,
CC     2           LBLS, NCLL-1, 2)
         ELSE
            CALL LBLBAR(0, XBARMN, XBARMX, YBARMN, YBARMX,
     1           NCLL,1.,XPER, LFIN, 0,
     2           LBLS, NCLL-1, 1)
CC            CALL LBLBAR(0, XBARMN, XBARMX, YBARMN, YBARMX,
CC     1           NCLL, .5, .5, LFIN, 0,
CC     2           LBLS, NCLL-1, 2)
         ENDIF
      ELSE IF(.NOT.CLRPLT) THEN
C     Drawing non-color shading patterns in legend boxes.
         DO 30 I = 1, NPAT
            CALL DFNCLR(IPAT(I), LFIN(I))
 30      CONTINUE
         IF(PROJ.EQ.'ST') THEN
            CALL LBSETR('WLB',3.)
            CALL LBLBAR(1, XBARMN,XBARMX, YBARMN, YBARMX,
     1           NCLL,YPER,1., LFIN, 2,
     2           LBLS, NCLL-1, 1)
CC            CALL LBLBAR(1, XBARMN,XBARMX, YBARMN, YBARMX,
CC     1           NCLL, .4, .45, LFIN, 2,
CC     2           LBLS, NCLL-1, 2)
         ELSE
            CALL LBLBAR(0, XBARMN,XBARMX, YBARMN, YBARMX,
     1           NCLL,1., XPER, LFIN, 2,
     2           LBLS, NCLL-1, 1)
CC            CALL LBLBAR(0, XBARMN,XBARMX, YBARMN, YBARMX,
CC     1           NCLL, .5, .5, LFIN, 2,
CC     2           LBLS, NCLL-1, 2)
         ENDIF
      ELSE
C Drawing mixed colour/pattern shading in legend boxes.
         DO 40 I = 1, NPAT
            IF (IPAT(I).GE.100 .AND. IPAT(I).LE.199) THEN
               IF(SABR(I).NE.0.) THEN
                  LFIN(I) = 419 + I
               ELSE
                  LFIN(I) = IPAT(I) - 98
               ENDIF
            ELSEIF (IPAT(I).GE.350 .AND. IPAT(I).LE.420) THEN
               LFIN(I) = IPAT(I) - 248
            ELSE
               CALL DFNCLR(IPAT(I), LFIN(I))
            ENDIF
 40      CONTINUE

         IF(PROJ.EQ.'ST') THEN
            CALL LBSETR('WLB',3.)
            CALL LBLBAR(1, XBARMN,XBARMX, YBARMN, YBARMX,
     1           NCLL, .3, 1., LFIN, 2,
     2           LBLS, NCLL-1, 1)
CC            CALL LBLBAR(1, XBARMN,XBARMX, YBARMN, YBARMX,
CC     1           NCLL, .4, .45, LFIN, 2,
CC     2           LBLS, NCLL-1, 2)
         ELSE
            CALL LBLBAR(0, XBARMN,XBARMX, YBARMN, YBARMX,
     1           NCLL,1., XPER, LFIN, 2,
     2           LBLS, NCLL-1, 1)
CC            CALL LBLBAR(0, XBARMN,XBARMX, YBARMN, YBARMX,
CC    1           NCLL, .5, .5, LFIN, 2,
CC    2            LBLS, NCLL-1, 2)
         ENDIF
      ENDIF
  992 FORMAT(I7)
 1000 FORMAT('0')
 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
