*-----------------------------------------------------------------------
*     TONE ROUTINE ON RC (HARD FILL - CLIPPING)
*-----------------------------------------------------------------------
*     Copyright (C) 2000-2022 GFD Dennou Club. All rights reserved.
*-----------------------------------------------------------------------
      SUBROUTINE SZOPTR

      PARAMETER (NMAX=16384, NLMAX=100, EPSIL = 1.E-5)

      INTEGER   NBGN(NLMAX), NLEN(NLMAX), NSTAT(NLMAX)
      REAL      RXX (NMAX),  RYY (NMAX),  POS  (NLMAX)
      REAL      XB(2), YB(2), BDX(4), BDY(4)
      LOGICAL   LFIRST, LVALID, LMOVE, LCONT, LREQA

      COMMON    /SZBTN2/ IRMODE, IRMODR

      EXTERNAL  IMOD, LREQA

      SAVE

      POSBD(X,Y) =
     +     (-1)**(NINT(((XB(2)-X)/XWIDTH+(YB(2)-Y)/YWIDTH)/2) + IRMODR)
     +     *((XB(2)-X)/XWIDTH + (Y-YB(1))/YWIDTH) + 2

*     POSBD RAGES FROM 0 TO 4. (AT UPPER LEFT CORNER)
*     ANTI-CLOCK WISE (IMODE=0), CLOCK WISE (IMODE=1)


      CALL SZQCLL(XB(1), XB(2), YB(1), YB(2), 0)
      XWIDTH = XB(2) - XB(1)
      YWIDTH = YB(2) - YB(1)

      DO 5 I=1, 4
        BDX(I) = XB(MOD((I+3+IRMODR)/2, 2) + 1)
        BDY(I) = YB(MOD((I+2-IRMODR)/2, 2) + 1)
    5 CONTINUE

      NN = 0
      NLINE = 0
      LFIRST = .TRUE.

      RETURN
*-----------------------------------------------------------------------
      ENTRY SZSTTR(RX, RY)

      IF (LFIRST) THEN
        RX0 = RX
        RY0 = RY
        LFIRST = .FALSE.
      ELSE
        IF (LREQA(RX0, RX1, EPSIL) .AND. LREQA(RY0, RY1, EPSIL)) RETURN
      END IF

      CALL SZPCLL(RX0, RY0, RX, RY, LVALID, 0)
      IF (LVALID) THEN
   10   CONTINUE
          NN = NN+1
          IF (NN.GT.NMAX) CALL MSGDMP('E', 'SZSTTR',
     +         'WORKING AREA OVER FLOW (TOO MANY POINTS)')
          CALL SZGCLL(RXX(NN), RYY(NN), LCONT, LMOVE, 0)
          IF (LMOVE) THEN
            NLINE = NLINE +1
            IF (NLINE.GT.NLMAX) CALL MSGDMP('E', 'SZSTTR',
     +           'WORKING AREA OVER FLOW (TOO MANY LINES)')
            NBGN(NLINE) = NN
          END IF
        IF (LCONT) GO TO 10
      END IF

      RX0 = RX
      RY0 = RY

      RETURN
*-----------------------------------------------------------------------
      ENTRY SZCLTR

      IF (LFIRST) RETURN

      IF (NLINE.EQ.0) THEN

        IF (NN.GE.3) THEN
          CALL SZOPTZ
          DO 200 I=1, NN
            CALL SZSTTZ(RXX(I), RYY(I))
  200     CONTINUE
          CALL SZCLTZ
        END IF
        RETURN

      ELSE

*       / PREPEARIG /

        DO 300 I=1, NLINE-1
          NLEN(I) = NBGN(I+1) - NBGN(I)
  300   CONTINUE
        NLEN(NLINE) = NN - NBGN(NLINE) + NBGN(1)

        DO 310 I=1, NLINE
          NSTAT(I) = 0
          IF(NLEN(I).LE.2) NSTAT(I) = 2
          NBG = NBGN(I)
          POS(I) = POSBD(RXX(NBG), RYY(NBG))
  310   CONTINUE

*       / SCANNING STARTING POINT /

  400   CONTINUE

          NX = 0
          DO 410 ILINE=1, NLINE
            IF (NSTAT(ILINE).EQ.0) GO TO 420
  410     CONTINUE
          RETURN

  420     CONTINUE
          NSTAT(ILINE) = 1
          CALL SZOPTZ
  430     CONTINUE
          NEND = NBGN(ILINE) + NLEN(ILINE) - 1

          DO 440 J = NBGN(ILINE), NEND
            NX = NX + 1
            JJ = MOD(J-1, NN) + 1
            CALL SZSTTZ(RXX(JJ), RYY(JJ))
  440     CONTINUE
          NEND = MOD(NEND-1, NN) + 1
          POS0 = POSBD(RXX(NEND), RYY(NEND))

*         / SEARCH NEXT LINE /

          DIF0 = 4
          DO 450 I=1, NLINE
            IF (NSTAT(I).EQ.2) GO TO 450
            DIF = RMOD(POS(I) - POS0+EPSIL, 4.)
            IF (DIF.GE.DIF0) GO TO 450
            IF (NLEN(I).LE.2) GO TO 450
            ILINE = I
            DIF0 = DIF
  450     CONTINUE

*         / BOUNDARY /

          POS1 = POS(ILINE)
          NS0 = POS0 + 1
          NS1 = POS1 + 1
          NST  = NS0 + 1
          NEND = NS0 + IMOD(NS1 - NS0, 4)
          IF (NS0.EQ.NS1 .AND. POS0.GT.POS1+EPSIL) NEND = NEND +4

          DO 600 I=NST, NEND
            II = IMOD(I-1, 4) + 1
            CALL SZSTTZ(BDX(II), BDY(II))
  600     CONTINUE

          IF (NSTAT(ILINE).EQ.0) THEN
            NSTAT(ILINE) = 2
            GO TO 430
          END IF
          NSTAT(ILINE) = 2
          CALL SZCLTZ

        GO TO 400

      END IF

      RETURN
      END
