      SUBROUTINE NEW_HAFTNP (Z,L,M,N,ISPV,SPVAL,BOXDRW)

C     * SEP 18/2006 - F.MAJAESS (MODIFIED FOR TOLERANCE IN SPVAL)
C     * MAR 11/2004 - M.BERKLEY (MODIFIED for CCCMA)

C      * This routine is based on HAFTNP routine implemented in
C        CCCMA using NCAR v2.0. In NEW_HAFTNP, common blocks are removed
C        from old HAFTNP and the legend section is also removed.
C        COMMON /FILLCB/ is added into NEW_HAFTNP.
C      * BOXDRW = LOGICAL SWITCH CONTROL THE DRAWING OF GRID BOX
C      *          SIDES.

      SAVE
      PARAMETER(MCRA=300000,MSRA=300000)
      DIMENSION Z(L,N)
      DIMENSION VWPRT(4),WNDW(4),VWPR1(4),WND1(4)
      DIMENSION XCRA(MCRA),YCRA(MCRA),ISRA(MCRA),FSRA(MCRA)
      DIMENSION XZ(MCRA),YZ(MCRA)
      LOGICAL ZSET
      LOGICAL BOXDRW

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


      COMMON /FILLPATTERNS/ FILPAT, FILTYP, FILANG, FILSPC
      INTEGER         FILPAT(0:420), FILTYP(0:420)
      REAL            FILANG(0:420), FILSPC(0:420)

      REAL MAXPT
      DATA MAXPT/420/

      REAL            SPVALT
      REAL            XLO,XHY,YLO,YHY,A,B,C,D,XX,YY
      INTEGER         I,T,P,ISOLID
      REAL            CHRATIO
      CHARACTER*11    IDUMMY
      EQUIVALENCE     (ISRA(1),XZ(1)),(FSRA(1),YZ(1))

C     * DATA PERTAINING TO CHARACTER SIZES FOR PCHIQU.
C     * NOTE:  THE FONT PCHIQU USES IS DIGITIZED TO BE 32 PLOTTER
C     * COORDINATE UNITS (PLU) HIGH - THIS INCLUDES SPACE ABOVE THE
C     * CHARACTER.  THE ACTUAL CHARACTER HEIGHT IS 21 PLU.  THEREFORE,
C     * THE ACTUAL HEGHT FOR A GIVEN CHARACTER SIZE CAN BE DETERMINED
C     * BY MULTIPLYING BY THE RATIO 32/21 = 1.52381
      DATA CHRATIO /1.52381/

C
C     * AMOUNT OF SCRATCH SPACE AVAILABLE FOR SUBROUTINE FILL (SET MSCR=MSRA)
      DATA MSCR/10000/
      DATA ISOLID/O'177777'/

C     * SETUP IN "SPVALT" THE TOLERANCE TO CHECK "SPVAL" AGAINST.

      SPVALT=1.E-6*SPVAL

C!!!      write(*,*) 'ISPV ',ISPV
C

C
C THE FOLLOWING CALL IS FOR GATHERING STATISTICS ON LIBRARY USE AT NCAR
C
      CALL Q8QST4 ('GRAPHX','HAFTNP','HAFTNP','VERSION  1')
C
      CALL DASHDB(ISOLID)
      CALL GETSET(XLO,XHY,YLO,YHY,A,B,C,D,I)
C
      NPOINT = 0
C      NLEVL = MIN0(IABS(NPAT),MXLEV)
C      IF (NLEVL .LE. 1) NLEVL = MXLEV
      NLEVL = NPAT
      MX = L
      NX = M
      NY = N
C
C SET INTENSITY BOUNDARY LEVELS
C
C      IF(.NOT.ZSET) CALL ZLSET (Z,MX,NX,NY,ZLEV,NLEVL)
C
C SET UP PERIMETER
C
      X3 = NX
      Y3 = NY
      CALL GQCNTN (IERR,NTORIG)
      CALL GETUSV('LS',IOLLS)
C
C     * SET THE DOT SIZE
C
      CALL GQNT (NTORIG,IERR,WNDW,VWPRT)
      X1 = VWPRT(1)
      X2 = VWPRT(2)
      Y1 = VWPRT(3)
      Y2 = VWPRT(4)
C
C SAVE NORMALIZATION TRANS 1
C
C      CALL GQNT (1,IERR,WNDW,VWPRT)
C
C DEFINE NORMALIZATION TRANS 1 AND LOG SCALING FOR USE WITH PERIM
C DRAW PERIMETER IF NPRIM EQUALS 0
C
C      CALL SET(X1,X2,Y1,Y2,1.0,X3,1.0,Y3,1)
C
C     *  THIS PART DOES THE BOX SHADING.
C
C     * SETUP THE DIMENSIONS IN FRACTIONAL AND PLOTTER COORDINATES.
C
      DXF = (VWPRT(2) - VWPRT(1) ) / FLOAT(M-1)
      DYF = (VWPRT(4) - VWPRT(3) ) / FLOAT(N-1)
      DXU = FLOAT(KFPX(DXF))
      DYU = FLOAT(KFPY(DYF))
      HDXU = FLOAT(KFPX(0.5*DXF))
      HDYU = FLOAT(KFPY(0.5*DYF))
C
C     * LOOP ONCE FOR FILL, ONCE FOR BOXES - INEFFICIENT, BUT EFFECTIVE
C
      DO 340 KLOOP=1,2
C
C     * GO THROUGH EACH DATA POINT.
C
         DO 330 J=1,N
C
C          * SET THE DIMESIONS FOR THE PALETTE AREA IN THE Y-DIRECTION.
C
            DY=DYF
            DUY=DYU
            YYB=VWPRT(3)+((J-1)*DYF)-(0.5*DYF)
            IF(YYB.LT.VWPRT(3)) THEN
               YYB=VWPRT(3)
               DY=0.5*DYF
               DUY=HDYU
            ENDIF
            YYT=YYB+DY
            IF(YYT.GT.VWPRT(4)) THEN
               YYT=VWPRT(4)
               DY=0.5*DYF
               DUY=HDYU
            ENDIF

            DO 320 I=1,M
C
C              * SKIP THE DATA POINT IF INSTRUCTED TO DO SO.
C
               IF ((ISPV.NE.0).AND.
     1             (ABS(Z(I,J)-SPVAL).LT.SPVALT)) GO TO 320
C
C              * FIND OUT THE APPROPRIATE PATTERN CODE TO USE
C              * BASED ON THE GRID POINT VALUE.
C
               DO 300 K=1, NLEVL-1
                  IF ((K .EQ. 1) .AND. (Z(I,J) .LT. ZLEV(1))) THEN
                     IPT=IPAT(1)
                     GO TO 310
                  ENDIF
                  IF (K.EQ.(NLEVL-1)) THEN
                     IPT=IPAT(NLEVL)
                     GO TO 310
                  ENDIF
                  IF ((Z(I,J).GE.ZLEV(K))
     1                 .AND.(Z(I,J).LT.ZLEV(K+1))) THEN
                     IPT=IPAT(K+1)
                     GO TO 310
                  ENDIF
 300           CONTINUE
 310           CONTINUE

C              * MAKE SURE IPT IS A VALID NUMBER - I.E. BETWEEN 1 & 64 OR
C              * 100 & MAXPT
               IF (IPT .LT. 1 .OR. (IPT .GT. 64.AND.IPT .LT. 100).OR.
     +              IPT .GT. MAXPT) THEN
                  IPT = 0
               ENDIF

C              * ONLY DO NON-BLANK FILLS
               IF (FILPAT(IPT).GT.0) THEN
C
C                 * SET THE PALETTE AREA.
C
                  DX=DXF
                  DUX=DXU
                  XXL=VWPRT(1)+((I-1)*DXF)-(0.5*DXF)
                  IF(XXL.LT.VWPRT(1)) THEN
                     XXL=VWPRT(1)
                     DX=0.5*DXF
                     DUX=HDXU
                  ENDIF
                  XXR=XXL+DX
                  IF(XXR.GT.VWPRT(2)) THEN
                     XXR=VWPRT(2)
                     DX=0.5*DXF
                     DUX=HDXU
                  ENDIF

                  CALL SET(XXL,XXR,YYB,YYT,0.,DUX,0.,DUY,1)

                  XCRA(1)=0.
                  XCRA(2)=DUX
                  XCRA(3)=DUX
                  XCRA(4)=0.

                  YCRA(1)=0.
                  YCRA(2)=0.
                  YCRA(3)=DUY
                  YCRA(4)=DUY

                  IF(KLOOP.EQ.1) THEN
C
C                    * FILL THE BOX
C
                     IF (FILTYP(IPT) .GT. 0) THEN
                        CALL SETPAT(FILPAT(IPT))
                        CALL SFSETP(LDP)
                        CALL SFSETI('DO - DOT FILL', 1)
                        CALL SFSETR('AN', FILANG(IPT))
                        CALL SFSETR('SP', FILSPC(IPT))
                        CALL SFSETI('TY', 1)
                        CALL SFSETI('CH',-FILTYP(IPT))
                     ELSE
                        CALL SFSETI('DO - NO DOT FILL', 0)
                        CALL SFSETR('AN', FILANG(IPT))
                        CALL SFSETR('SP', FILSPC(IPT))
                        CALL SFSETI('TY', FILTYP(IPT))
                     ENDIF
                     CALL SFSGFA(XCRA,YCRA,4,FSRA,MCRA,
     1                    ISRA,MCRA,FILPAT(IPT))

                  ELSE
C
C                    * OR DRAW THE BOX SIDES IF REQUESTED.
C
                     IF ( BOXDRW ) THEN
C                       * SET THE FOREGROUND COLOUR TO BLACK
                        CALL GSCR(1, 1, 0.0, 0.0, 0.0)
                        CALL GSLN(1)
                        CALL GSPLCI(1)
                        CALL GSLWSC(1.0)
                        CALL FRSTPT(XCRA(1),YCRA(1))
                        DO 315 K=2,4
                           CALL VECTOR(XCRA(K),YCRA(K))
 315                    CONTINUE
                        CALL VECTOR(XCRA(1),YCRA(1))
                        CALL SFLUSH
                     ENDIF
                  ENDIF
               ENDIF
 320        CONTINUE
 330     CONTINUE
 340  CONTINUE
C
C RESTORE NORMALIZATION TRANS 1, ORIGINAL NORMALIZATION NUMBER AND MARKER SIZE
C
  132 CONTINUE
      CALL SET(VWPRT(1),VWPRT(2),VWPRT(3),VWPRT(4),
     -         WNDW(1),WNDW(2),WNDW(3),WNDW(4),IOLLS)
      CALL SETUSV('LS',IOLLS)
      CALL GSELNT (NTORIG)

      RETURN
C
      END
