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

      REAL      Z(MX,*)

      PARAMETER (MAXPXL=4000)

      INTEGER   IMAGE(MAXPXL)
      LOGICAL   LMISS,LIMC

      COMMON    /UEBLK1/ TL1,TL2,IPT,NT,LASCND
      PARAMETER (MAXNT=100)
      LOGICAL   LASCND
      INTEGER   IPT(MAXNT)
      REAL      TL1(MAXNT),TL2(MAXNT)

      REAL      TXMIN,TXMAX,TYMIN,TYMAX,TUX,TUY,TUXZ,TUYZ
      LOGICAL   LEXTEN

*     / CHECK IMAGE CAPABILITY /

      CALL SWQIMC(LIMC)
      IF (.NOT.LIMC) THEN
        CALL MSGDMP('E','UETONF','NO IMAGE CAPABILITY.')
      END IF

*     / GET INTERNAL PARAMETERS /

      CALL GLRGET('RUNDEF  ',RUNDEF)
      CALL GLIGET('IUNDEF  ',IUNDEF)
      CALL GLLGET('LMISS   ',LMISS )
      CALL GLRGET('RMISS   ',RMISS )

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

      CALL UWDFLT(NX, NY)

*     / CHECK Z VALUES AND TONE LEVEL /

      CALL UEZCHK(Z,MX,NX,NY,'UETONF',ISTAT)
      IF (ISTAT.NE.0) RETURN

*     / INITIALIZE /

      CALL SGQVPT(VXMIN, VXMAX, VYMIN, VYMAX)

      CALL STFPR2(VXMIN, VYMIN, RX, RY)
      CALL STFWTR(RX, RY, WX1, WY1)
      CALL SWFINT(WX1, WY1, IX1, IY1)

      CALL STFPR2(VXMAX, VYMIN, RX, RY)
      CALL STFWTR(RX, RY, WX2, WY2)
      CALL SWFINT(WX2, WY2, IX2, IY2)

      CALL STFPR2(VXMAX, VYMAX, RX, RY)
      CALL STFWTR(RX, RY, WX3, WY3)
      CALL SWFINT(WX3, WY3, IX3, IY3)

      CALL STFPR2(VXMIN, VYMAX, RX, RY)
      CALL STFWTR(RX, RY, WX4, WY4)
      CALL SWFINT(WX4, WY4, IX4, IY4)

      IXMIN  = MIN(IX1, IX2, IX3, IX4)
      IYMIN  = MIN(IY1, IY2, IY3, IY4)
      IXMAX  = MAX(IX1, IX2, IX3, IX4)
      IYMAX  = MAX(IY1, IY2, IY3, IY4)
      IWIDTH = IXMAX-IXMIN+1
      IHIGHT = IYMAX-IYMIN+1
        CALL SGQTXY(TXMIN,TXMAX,TYMIN,TYMAX)

      CALL SWIOPN(IXMIN, IYMIN, IWIDTH, IHIGHT,
     +            WX1, WY1, WX2, WY2, WX3, WY3, WX4, WY4)

*     / LOOP FOR EACH PIXEL /

        CALL SGQTXY(TXMIN,TXMAX,TYMIN,TYMAX)

      DO 30 J=1, IHIGHT
        DO 20 I=1, IWIDTH

          CALL SWIINT(I+IXMIN-1, J+IYMIN-1, WX, WY)
          CALL STIWTR(WX, WY, RX, RY)
          CALL STIPR2(RX, RY, VX, VY)
          IF (VX .LT. VXMIN .OR. VX .GT. VXMAX .OR.
     +        VY .LT. VYMIN .OR. VY .GT. VYMAX) THEN
            UX = RUNDEF
          ELSE
            CALL STITRF(VX, VY, UX, UY)
          END IF

          IF (UX.EQ.RUNDEF) THEN
            IMAGE(I) = 0
          ELSE

          CALL SGQTRN(ITR)

          IF (ITR.EQ.5) THEN
            CALL SGRGET('UYMAX',UYX)
            CALL SGRGET('UYMIN',UYN)
            IF (UYX .LT. (UYN+360.)) THEN
              UYX=UYN+360.
            END IF
          END IF
        CALL UWQGXI(UX,IX,FX)
        CALL UWQGYI(UY,IY,FY)
        CALL STITRN(VX, VY, TUXZ, TUYZ)
        CALL STIRAD(TUXZ,TUYZ,TUX,TUY)
        IF(TXMIN.LE.TXMAX)THEN
          IF ((TUX.GE.TXMIN).AND.(TUX.LE.TXMAX))THEN
            LEXTEN=.FALSE.
          ELSE
            LEXTEN=.TRUE.
          END IF
        ELSE
          IF ((TUX.GE.TXMIN).OR.(TUX.LE.TXMAX))THEN
            LEXTEN=.FALSE.
          ELSE
            LEXTEN=.TRUE.
          END IF
        END IF
        IF ((TUY.GE.TYMAX).OR.(TUY.LE.TYMIN))THEN
          LEXTEN=.TRUE.
        END IF
        IF(LEXTEN.AND.((ITR.GT.5).AND.(ITR.NE.51)))THEN
              IMAGE(I) = 0
        ELSE IF (IX.EQ.IUNDEF .OR. IY.EQ.IUNDEF) THEN
              IMAGE(I) = 0
        ELSE
              IF (LMISS .AND.
     +             (Z(IX  , IY  ).EQ.RMISS .OR.
     +              Z(IX+1, IY  ).EQ.RMISS .OR.
     +              Z(IX  , IY+1).EQ.RMISS .OR.
     +              Z(IX+1, IY+1).EQ.RMISS)     ) THEN
                IMAGE(I) = 0
              ELSE
                ZZ = (Z(IX, IY  )*(1-FX) + Z(IX+1,IY  )*FX)*(1-FY)
     +             + (Z(IX, IY+1)*(1-FX) + Z(IX+1,IY+1)*FX)*FY
                IF (TL1(1) .LE. ZZ .AND. ZZ .LE. TL2(NT)) THEN
                  IMAGE(I) = IUETON(ZZ)/1000
                  IF(IMAGE(I) .EQ. IBGCLI) THEN
                    IMAGE(I)=0
                  ENDIF
                ELSE
                  IMAGE(I) = 0
                END IF
              END IF
            END IF
          END IF

   20   CONTINUE

        CALL SWIDAT(IMAGE, IWIDTH)

   30 CONTINUE

      CALL SWICLS

      END
