*-----------------------------------------------------------------------
*     UDCNTZ
*-----------------------------------------------------------------------
*     Copyright (C) 2000-2022 GFD Dennou Club. All rights reserved.
*-----------------------------------------------------------------------
      SUBROUTINE UDCNTZ(Z,MX,NX,NY,IBR,NBR2)

      INTEGER   IBR(NBR2)
      REAL      Z(MX,*)

      INTEGER   NS(2),NP(2),NQ(2)
      LOGICAL   LUDCHK,LOPEN,LMISS,LMADA,LOK,LSET,LMSG,
     +          LEPSL,LCHAR,LMAP,LCLIP,LPRINT,LEXIT,LCENT
      CHARACTER CMSG*80

      COMMON    /UDBLK1/ NB,LX,LY,NBR
      COMMON    /UDBLK2/ NL,CZL,IDX,ITY,HLV
      COMMON    /UDBLK3/ CLAB
      PARAMETER (NLX=50)
      INTEGER   IDX(NLX),ITY(NLX)
      REAL      CZL(NLX),HLV(NLX)
      CHARACTER CLAB(NLX)*8

      EXTERNAL  RVMIN,RVMAX,RUDLEV,LUDCHK

      SAVE


*     / GET INTERNAL PARAMETERS /

      CALL UDRGET('RSIZET  ',RSIZE )
      CALL UDRGET('XTTL    ',XTTL  )
      CALL UDLGET('LMSG    ',LMSG  )
      CALL UDLGET('LCENT   ',LCENT )
      CALL UDIGET('NLEV    ',NLEV  )
      CALL UDIGET('INDXMJ  ',INDEX )

      CALL GLLGET('LMISS',LMISS)
      CALL GLRGET('RMISS',RMISS)
      CALL GLIGET('NBITSPW',NB)
      CALL GLLGET('LEPSL',LEPSL)
      CALL SGLGET('LCHAR',LCHAR)

      CALL STQTRF(LMAP)

*     / SET INTERNAL PARAMETER /

      CALL GLLSET('LEPSL',.TRUE.)
      CALL SGLSET('LCHAR',.TRUE.)

*     / CHECK WORKING ARRAY SIZE /

      NBR=NBR2/2
      LX=NX+2
      LY=NY+2
      NWRD=LX*LY*2/NB+1
      IF (NWRD.GT.NBR) THEN
        CALL MSGDMP('M','UDCNTR','WORKING AREA IS NOT ENOUGH.')
        CMSG='NBR2/2 SHOULD BE LARGER THAN (NX+2)*(NY+2)/##+1.'
        WRITE(CMSG(44:45),'(I2)') NB/2
        CALL MSGDMP('E','-CNT.-',CMSG)
      END IF

*     / SET GRID ATTRIBUTE IF IT HAS NOT BEEN SET YET /

      CALL UWDFLT(NX,NY)

*     / CHECK MIN & MAX /

      NS(1)=MX
      NS(2)=NY
      NP(1)=1
      NP(2)=1
      NQ(1)=NX
      NQ(2)=NY
      RMINZ=RVMIN(Z,NS,NP,NQ,2)
      RMAXZ=RVMAX(Z,NS,NP,NQ,2)

      LMADA=LMISS .AND. RMINZ.EQ.RMISS .AND. RMAXZ.EQ.RMISS

      IF (LMADA .OR. RMINZ.EQ.RMAXZ) THEN

*       / MESSAGE FOR MISSING OR CONSTANT FIELD /

        IF (LMADA) THEN
          CMSG='MISSING FIELD.'
        ELSE
          CMSG='CONSTANT (##########) FIELD.'
          WRITE(CMSG(11:20),'(1P,E10.3)') RMINZ
        END IF
        CALL MSGDMP('W','UDCNTR',CMSG)

        LPRINT=LMSG
        LEXIT=.TRUE.

      ELSE

*       / GENERATE CONTOUR LEVELS IF THEY HAVE NOT BEEN GENERATED YET /

        CALL UDQCLZ(LSET)
        IF (.NOT.LSET) THEN
          CALL UDGCLB(Z,MX,NX,NY,-REAL(NLEV))
          CALL UDSCLZ(.FALSE.)
        END IF

*       / CHECK INAPPROPRIATE DATA /

        DO 10 K=1,NY
          DO 15 J=1,NX

            LOK=.NOT.(LMISS .AND. Z(J,K).EQ.RMISS)

            DO 20 I=1,NL
              IF (LOK .AND. Z(J,K).EQ.CZL(I)) THEN
                XXX=RUDVAL(Z(J,K),CZL(I))
                CMSG='INAPPROPRIATE DATA WILL BE MODIFIED INTERNALLY.'
                CALL MSGDMP('M','UDCNTR',CMSG)
                WRITE(CMSG(1:80),500) J,K,Z(J,K),XXX
  500           FORMAT('Z(',I3,',',I3,')=',G16.9,' ===> ',G16.9)
                CALL MSGDMP('M','-CNT.-',CMSG)
              END IF
   20       CONTINUE

   15     CONTINUE
   10   CONTINUE

*       / CONTOUR INTERVAL /

        DZ=RUDLEV(1)
        CMSG='CONTOUR INTERVAL =##########'
        WRITE(CMSG(19:28),'(1P,E10.3)') DZ

        LPRINT=NL.GE.2 .AND. LMSG
        LEXIT=.FALSE.

      END IF

*     / PRINT MESSAGE /

      IF (LPRINT) THEN
        CALL SGLGET('LCLIP', LCLIP)
        CALL SGLSET('LCLIP',.FALSE.)
        CALL SGQVPT(VXMN,VXMX,VYMN,VYMX)
        XPT=(VXMN+VXMX)/2
        IF (LMAP.AND.LCENT) THEN
          YPT=VYMN/2
        ELSE
          CALL UZRGET('ROFFXB',ROFFX)
          CALL UZRGET('PAD1',PAD)
          YPT=VYMN+ROFFX-RSIZE*(PAD*2+1.5)
          ROFFX=ROFFX-RSIZE*(PAD+1.0)*2
          CALL UZRSET('ROFFXB',ROFFX)
        END IF
        CALL CUPPER(CMSG)
        CALL SGTXZV(XPT,YPT,CMSG,RSIZE,0,0,INDEX)
        CALL SGLSET('LCLIP',LCLIP)
        IF (LEXIT) GO TO 100
      END IF

*     / CHECK BOUND /

      CALL UDICLR(IBR,NBR*2)

      DO 25 K=0,1
        K1=1-K
        DO 30 IY=1,NY-K
          IY1=IY+K
          DO 35 IX=1,NX-K1
            IX1=IX+K1
            IF (.NOT.(LMISS .AND.
     +        (Z(IX1,IY).EQ.RMISS .OR. Z(IX,IY1).EQ.RMISS))) THEN
              CALL UDBSET(IX,IY,K,1,IBR)
            END IF
   35     CONTINUE
   30   CONTINUE
   25 CONTINUE

      DO 40 K=0,1
        K1=1-K
        DO 45 IY=1,NY-K
          IY1=IY+K1
          IY2=IY-K1
          DO 50 IX=1,NX-K1
            IX1=IX+K
            IX2=IX-K
            IF (.NOT.LUDCHK(IX1,IY1,K,1,IBR)
     +          .AND. .NOT.LUDCHK(IX2,IY2,K,1,IBR)) THEN
              CALL UDBCLR(IX,IY,K,1,IBR)
            END IF
   50     CONTINUE
   45   CONTINUE
   40 CONTINUE

*     / DRAW CONTOURS /

      DO 55 LC=1,NL

*       / INITIALIZE /

        CX=CZL(LC)
        IF (.NOT.(RMINZ.LT.CX .AND. CX.LT.RMAXZ)) GO TO 55

        IF (HLV(LC).LE.0) THEN
          CALL SZCRST
        ELSE
          NLAB=LENC(CLAB(LC))
          CALL SZSCHZ(CLAB(LC)(1:NLAB),HLV(LC))
        END IF
        CALL SZSLTI(ITY(LC),IDX(LC))

        CALL UDICLR(IBR,NBR)

*       / CHECK BRANCH /

        NN=0
        DO 60 K=0,1
          K1=1-K
          DO 65 IY=1,NY-K
            IY1=IY+K
            DO 70 IX=1,NX-K1
              IX1=IX+K1
              IF (Z(IX1,IY).EQ.CX) THEN
                ZZ1=RUDVAL(Z(IX1,IY),CX)
              ELSE
                ZZ1=Z(IX1,IY)
              END IF
              IF (Z(IX,IY1).EQ.CX) THEN
                ZZ2=RUDVAL(Z(IX,IY1),CX)
              ELSE
                ZZ2=Z(IX,IY1)
              END IF
              IF (LUDCHK(IX,IY,K,1,IBR)) then
                if ((ZZ1-CX)*(ZZ2-CX).LT.0) THEN
                  CALL UDBSET(IX,IY,K,0,IBR)
                  NN=NN+1
                end if
              END IF
   70       CONTINUE
   65     CONTINUE
   60   CONTINUE

        IF (NN.NE.0) THEN

*         / BOUND TO BOUND CONTOURS /

          DO 75 K=0,1
            K1=1-K
            DO 80 IY=1,NY-K
              DO 85 IX=1,NX-K1
                IF (LUDCHK(IX,IY,K,0,IBR)) THEN
                  IX1=IX+K
                  IX2=IX-K
                  IY1=IY+K1
                  IY2=IY-K1
                  LOPEN=.NOT.(LUDCHK(IX1,IY1,K,1,IBR)
     +                  .AND. LUDCHK(IX2,IY2,K,1,IBR))
                  IF (LOPEN) THEN
                    CALL UDLINE(Z,MX,IX,IY,K,CX,LOPEN,IBR)
                  END IF
                END IF
   85         CONTINUE
   80       CONTINUE
   75     CONTINUE

*         / CLOSED CONTOURS /

          K=0
          K1=1-K
          DO 90 IY=1,NY-K
            DO 95 IX=1,NX-K1
              IF (LUDCHK(IX,IY,K,0,IBR)) THEN
                IX1=IX+K
                IX2=IX-K
                IY1=IY+K1
                IY2=IY-K1
                LOPEN=.NOT.(LUDCHK(IX1,IY1,K,1,IBR)
     +                .AND. LUDCHK(IX2,IY2,K,1,IBR))
                IF (.NOT.LOPEN) THEN
                  CALL UDLINE(Z,MX,IX,IY,K,CX,LOPEN,IBR)
                END IF
              END IF
   95       CONTINUE
   90     CONTINUE

        END IF

   55 CONTINUE

*     / RESET INTERNAL PARAMETER /

  100 CALL GLLSET('LEPSL',LEPSL)
      CALL SGLSET('LCHAR',LCHAR)

      END
