      SUBROUTINE INITCL(FLOW, FHIGH, FINC, FINCN,
     1     F,NLATP,LXP,RWRK,LRWK,IWRK,LIWK)

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

      IMPLICIT NONE
C     INITialize Contour Levels routine. If FINC=0,
C     this subroutine sets the parameters necessary, then call
C     CPRECT.

      REAL FLOW, FHIGH
      REAL FINC, FINCN
      REAL F(*)
      INTEGER NLATP, LXP
      INTEGER LRWK, LIWK
      REAL RWRK(*)
      INTEGER IWRK(*)


      INTEGER I,NIT
      PARAMETER (NIT=10)
      REAL TOL
      PARAMETER (TOL=1D-8)

C If FINC.NE.0, only call CPRECT.
      IF(FINC.GE.TOL) THEN
         CALL CPRECT(F,NLATP,NLATP,LXP,RWRK,LRWK,IWRK,LIWK)
         FINCN = FINC
         RETURN
      ENDIF

      CALL CPSETR('CMN - CONTOUR MINIMUM', FLOW)
      CALL CPSETR('CMX - CONTOUR MAXIMUM', FHIGH)

C Conpack will choose 10 to 20 contour levels at 'nice' intervals
C of 1EN, 2EN, OR 5EN
      CALL CPSETI('CLS - CONTOUR LEVEL SELECTION FLAG',10)
      CALL CPSETR('CIS - CONTOUR INTERVAL SPECIFIER', FINC)

      CALL CPSETI('PAI',1)
      CALL CPSETR('CIT',1.0)
      CALL CPSETI('PAI',2)
      CALL CPSETR('CIT',2.0)
      CALL CPSETI('PAI',3)
      CALL CPSETR('CIT',5.0)
      DO I = 1,3
         CALL CPSETI('PAI',I)
         CALL CPSETI('LIT',2)
      ENDDO
      DO I = 4,NIT
         CALL CPSETI('PAI',I)
         CALL CPSETR('CIT',0.0)
         CALL CPSETI('LIT',0)
      ENDDO

      CALL CPRECT(F,NLATP,NLATP,LXP,RWRK,LRWK,IWRK,LIWK)

      CALL CPPKCL(F,RWRK,IWRK)
      CALL CPGETR('CIU - CONTOUR INTERVAL USED', FINCN)

      RETURN
      END
