      SUBROUTINE CPCHHL(IFLG)

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

      IMPLICIT NONE
C
C     This routine replaces the null default in Conpack - ensures that
C     the H,L labels do not have three or more decimal places.
C

      INTEGER IFLG

      INTEGER CLEN
      PARAMETER (CLEN=30)
      CHARACTER*(CLEN) CVAL, ZDVTMP
      REAL ZVAL,ZMNTMP,ZMXTMP,FMAX
      INTEGER BEGZDV,ENDZDV,LENZDV

      INTEGER CPOS_START, CPOS_END, CPOS_DOT, ZPOS_NEG
      REAL TOL
      PARAMETER (TOL=0.001)
      CHARACTER*40 TSTR
      CHARACTER*3 CVOFF,CHOFF
      INTEGER IPH,IPW

      INTEGER STRINDEX,LSTRBEG,LSTREND
      EXTERNAL STRINDEX,LSTRBEG,LSTREND

C     HI LO COMMON BLOCK FOR HI AND LOW
      INTEGER ILOG
      REAL OFFSET
      COMMON /HILO/ ILOG, OFFSET
C
C!!!      WRITE(*,*)'CPCHHL'

C     Find the long labels and truncate them.
      IF ((IFLG .EQ. 1) .OR. (IFLG .EQ. 3)
     +     .OR. (IFLG .EQ. 5) .OR. (IFLG .EQ. 7)) THEN

C
         CALL PCGETI('PH - Digitized principal height',IPH)
         CALL PCGETI('PW - Digitized principal width',IPW)
         CALL PCSETI('CS - Constant-spacing flag',1)
         CALL CPGETR('ZMN - Z Minimum Value',ZMNTMP)
         CALL CPGETR('ZMX - Z Maximum Value',ZMXTMP)
         CALL CPGETC('ZDV', ZDVTMP)
         CALL CPGETC('CTM',CVAL)
         CALL CPGETR('ZDV - Z DATA VALUE',ZVAL)
         IF(ILOG.EQ.1.AND.OFFSET.EQ.0.) THEN
            ZVAL=10.**ZVAL
         ELSEIF(ILOG.EQ.1) THEN
            IF(ZVAL.GE.0.) THEN
               ZVAL=10.**(ZVAL-OFFSET)
            ELSE
               ZVAL=-10.**(-ZVAL-OFFSET)
            ENDIF
         ENDIF
         CPOS_START = 11
         CPOS_END = LSTREND(CVAL)
         CPOS_DOT = STRINDEX(CVAL,'.','F')
         ZPOS_NEG = STRINDEX(ZDVTMP,'-','F')

C!!!         WRITE(*,*)'start: ',ZDVTMP,CVAL
C!!!         WRITE(*,*)'start: ',ZVAL,CPOS_START,CPOS_END,
C!!!     1        CPOS_DOT,ZPOS_NEG,IPW

C!!!         IF(ABS(ZMXTMP).GT.ABS(ZMNTMP)) THEN
C!!!            FMAX=ABS(ZMXTMP)
C!!!         ELSE
C!!!            FMAX=ABS(ZMNTMP)
C!!!         ENDIF

         FMAX=ABS(ZVAL)
C!!!         WRITE(*,*)FMAX

         IF(FMAX.GE.1E4) THEN
            WRITE(ZDVTMP,615) ZVAL
 615        FORMAT(E8.2)
         ELSE IF(FMAX.GE.1000) THEN
            IF(ZVAL.GT.0) THEN
               WRITE(ZDVTMP,614) INT(ZVAL+0.5)
            ELSE
               WRITE(ZDVTMP,614) INT(ZVAL-0.5)
            ENDIF
 614        FORMAT(I5)
         ELSE IF(FMAX.GE.100) THEN
            IF(ZVAL.GT.0) THEN
               WRITE(ZDVTMP,613) INT(ZVAL+0.5)
            ELSE
               WRITE(ZDVTMP,613) INT(ZVAL-0.5)
            ENDIF
 613        FORMAT(I4)
         ELSE IF(FMAX.GE.10) THEN
            WRITE(ZDVTMP,612) ZVAL
 612        FORMAT(F5.1)
         ELSE IF(FMAX.GE.1) THEN
            WRITE(ZDVTMP,611) ZVAL
 611        FORMAT(F5.2)
         ELSE IF(FMAX.GE.0.01) THEN
            WRITE(ZDVTMP,610) ZVAL
 610        FORMAT(F5.2)
         ELSE
            WRITE(ZDVTMP,605) ZVAL
 605        FORMAT(E8.2)
         ENDIF

         BEGZDV=LSTRBEG(ZDVTMP)
         ENDZDV=LSTREND(ZDVTMP)
         LENZDV=ENDZDV-BEGZDV+1

C!!!         WRITE(*,*)BEGZDV,ENDZDV,LENZDV,ZDVTMP
C!!!
C!!!         WRITE(*,*)CVAL(1:CPOS_START-4)
C!!!         WRITE(*,*)    -(LENZDV/2.0+0.5)*IPW
C!!!         WRITE(*,*)INT(-(LENZDV/2.0+0.5)*IPW)
C!!!         WRITE(*,*)CVAL(CPOS_START:CPOS_START)
C!!!         WRITE(*,*)ZDVTMP(BEGZDV:ENDZDV)
C!!!         WRITE(*,*)CVAL((CPOS_END-2):CPOS_END)
C!!!         WRITE(*,*)CVAL(1:CPOS_START-4),
C!!!     1        INT(-(LENZDV/2.0+0.5)*IPW),
C!!!     2        CVAL(CPOS_START:CPOS_START),
C!!!     3        ZDVTMP(BEGZDV:ENDZDV),
C!!!     4        CVAL((CPOS_END-2):CPOS_END)

         WRITE(TSTR,99)CVAL(1:CPOS_START-4),
     1        INT(-(LENZDV/2.0+0.5)*IPW),
     2        CVAL(CPOS_START:CPOS_START),
     3        ZDVTMP(BEGZDV:ENDZDV),
     4        CVAL((CPOS_END-2):CPOS_END)
 99      FORMAT(A,I3,A,A,A)
         CVAL=TSTR
C!!!         WRITE(*,*)CVAL
         CALL CPSETC('CTM',CVAL)

      ENDIF

      RETURN
      END
