*-----------------------------------------------------------------------
*     TONE ROUTINE ON TC
*-----------------------------------------------------------------------
*     Copyright (C) 2000-2022 GFD Dennou Club. All rights reserved.
*-----------------------------------------------------------------------
      SUBROUTINE SZOPTT

      PARAMETER (NMAX=8192, NLMAX=100, EPSIL=1.E-5, EP2=1.E-3)

      INTEGER   NBGN(NLMAX), NLEN(NLMAX), NSTAT(NLMAX)
      REAL      TXX(NMAX),   TYY (NMAX),  POS  (NLMAX)
      REAL      XB(2), YB(2), BDX(4), BDY(4)
      LOGICAL   LFIRST, LCONT1, LCONT2, LCONT3, LMOVE, LVLDX, LVLDY,
     +          LREQA

      COMMON    /SZBTN2/ IRMODE, IRMODR

      EXTERNAL  IMOD, XMPLON, LREQA

      SAVE

      POSBD(X,Y) =
     +     (-1)**(NINT(((XB(2)-X)/XWIDTH+(YB(2)-Y)/YWIDTH)/2) + IRMODE)
     +     *((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)


      PI = RFPI()

      CALL SZQCLX(XB(1), XB(2))
      CALL SZQCLY(YB(1), YB(2))

      XWIDTH = XB(2) - XB(1)
      YWIDTH = YB(2) - YB(1)

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

      NN = 0
      NLINE = 0
      LFIRST = .TRUE.

      RETURN
*-----------------------------------------------------------------------
      ENTRY SZSTTT(TX, TY)

      TX1 = XMPLON(TX)
      TY1 = TY

      IF (LFIRST) THEN
        LFIRST = .FALSE.
        TX0 = TX1
        TY0 = TY1
        BX0 = TX1
        BY0 = TY1
        CX0 = TX1
        CY0 = TY1
      ELSE
        IF (LREQA(TX1,TX0,EPSIL) .AND. LREQA(TY1,TY0,EPSIL)) RETURN
      END IF

      CALL SZPIPT(TX0, TY0, TX1, TY1, 1)
   10 CONTINUE
        CALL SZGIPT(BX1, BY1, LCONT1)
        CALL SZPCLY(BX0, BY0, BX1, BY1, LVLDY, .FALSE.)
        IF(LVLDY) THEN
   20     CONTINUE
            CALL SZGCLY(CX1, CY1, LCONT2)
            CX1 = XMPLON(CX1)
            CALL SZPCLX(CX0, CY0, CX1, CY1, LVLDX, .FALSE.)
            IF (LVLDX) THEN
   30         CONTINUE
                NN = NN+1
                IF (NN.GT.NMAX) CALL MSGDMP('E', 'SZSTTT',
     +               'WORKING AREA OVER FLOW. (TOO MANY POINTS)')
                CALL SZGCLX(TXX(NN), TYY(NN), LCONT3, LMOVE)
                IF (.NOT. LREQA(ABS(TYY(NN)), PI/2, EPSIL) ) THEN
                  IF (LREQA( TXX(NN), XB(1), EPSIL)) THEN
                    TXX(NN) = XB(1) - EPSIL
                  ELSE IF (LREQA( TXX(NN), XB(2), EPSIL)) THEN
                    TXX(NN) = XB(2) + EPSIL
                  ENDIF
                ENDIF

                IF (LMOVE .OR. LCONT2) THEN
                  NLINE = NLINE +1
                  IF (NLINE.GT.NLMAX) CALL MSGDMP('E', 'SZSTTT',
     +                 'WORKING AREA OVER FLOW. (TOO MANY CROSSINGS)')
                  NBGN(NLINE) = NN
                END IF
              IF (LCONT3) GO TO 30
            END IF
            CX0 = CX1
            CY0 = CY1
          IF(LCONT2) GOTO 20
        ENDIF
        BX0 = BX1
        BY0 = BY1
      IF (LCONT1) GO TO 10
      TX0 = TX1
      TY0 = TY1

      RETURN
*-----------------------------------------------------------------------
      ENTRY SZCLTT

      IF (LFIRST) RETURN

      IF (NLINE.EQ.0) THEN

        IF (NN.GE.3) THEN
          CALL SZOPTV
          DO 200 I=1, NN
            CALL STFTRN(TXX(I), TYY(I), VX, VY)
            CALL SZSTTV(VX, VY)
  200     CONTINUE
          CALL SZCLTV
        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(TXX(NBG), TYY(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 SZOPTV
  430     CONTINUE
          NEND = NBGN(ILINE) + NLEN(ILINE) - 1
          DO 440 J = NBGN(ILINE), NEND
            NX = NX + 1
            JJ = MOD(J-1, NN) + 1
            CALL STFTRN(TXX(JJ), TYY(JJ), VX, VY)
            CALL SZSTTV(VX, VY)
  440     CONTINUE
          NEND = MOD(NEND-1, NN) + 1
          POS0 = POSBD(TXX(NEND), TYY(NEND))

*         / SEARCH NEXT LINE /

          DIF0 = 4.
          DO 450 I=1, NLINE
            IF (NSTAT(I).EQ.2) GO TO 450
            DIF = RMOD(POS(I) - POS0 + EP2, 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
          NLST = NS0 + IMOD(NS1 - NS0, 4)
          IF (NS0.EQ.NS1 .AND. POS0.GT.POS1 + EP2) NLST = NLST +4

          NEXT = NBGN(ILINE)
          DO 600 I=NS0, NLST

            I1 = IMOD(I-1, 4) + 1
            I2 = IMOD(I  , 4) + 1

            IF (I.EQ.NS0) THEN
              X1 = TXX(NEND)
              Y1 = TYY(NEND)
            ELSE
              X1 = BDX(I1)
              Y1 = BDY(I1)
            END IF

            IF (I.EQ.NLST) THEN
              X2 = TXX(NEXT)
              Y2 = TYY(NEXT)
            ELSE
              X2 = BDX(I2)
              Y2 = BDY(I2)
            END IF

            CALL SZPIPL(X1, Y1, X2, Y2, 3)
  520       CONTINUE
              CALL SZGIPL(XX, YY, LCONT1)
              CALL STFTRN(XX, YY, VX, VY)
              CALL SZSTTV(VX, VY)
            IF (LCONT1) GOTO 520

  600     CONTINUE

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

        GO TO 400

      END IF

      RETURN
      END
