*-----------------------------------------------------------------------
*     TONE ROUTINE ON VC (SOFT FILL - BUFFERING)
*-----------------------------------------------------------------------
*     Copyright (C) 2000-2022 GFD Dennou Club. All rights reserved.
*-----------------------------------------------------------------------
      SUBROUTINE SZOPTS

      PARAMETER (NMAX=8192)
      PARAMETER (NPAT=5,NBITS=16)

      INTEGER   IPAT(NPAT)
      REAL      VPX(NMAX),VPY(NMAX)
      LOGICAL   LFRST,LBITS,LDBLE,LUNDF,LRTRN
      CHARACTER CPAT(NPAT)*(NBITS),CMSG*80

      SAVE

      DATA      CPAT(1)/'1000000000000000'/
      DATA      CPAT(2)/'1000000010000000'/
      DATA      CPAT(3)/'1000100010001000'/
      DATA      CPAT(4)/'1010101010101010'/
      DATA      CPAT(5)/'1111111111111111'/

      DATA      LFRST/.TRUE./


      IF (LRTRN) RETURN

      NN=0
      IF (.NOT.LBITS) THEN
        CALL SGISET('NBITS',NBITS)
      END IF
      IF (L3.EQ.0) THEN
        CALL SGRSET('BITLEN',RL1)
      END IF

      RETURN
*-----------------------------------------------------------------------
      ENTRY SZSTTS(VX,VY)

      IF (LRTRN) RETURN

      NN=NN+1
      IF (NN.GT.NMAX)
     +     CALL MSGDMP('E', 'SZSTTS', 'WORKING AREA OVER FLOW')

      VPX(NN)=VX
      VPY(NN)=VY

      RETURN
*-----------------------------------------------------------------------
      ENTRY SZCLTS

      IF (LRTRN) RETURN

      CALL SZTNSV(NN,VPX,VPY,IROTA,RSPCE,ITYPE,INDEX)
      IF (LDBLE) THEN
        CALL SZTNSV(NN,VPX,VPY,IROTA+90,RSPCE,ITYPE,INDEX)
      END IF

      IF (.NOT.LBITS) THEN
        CALL SGISET('NBITS',NBITSZ)
      END IF
      IF (L3.EQ.0) THEN
        CALL SGRSET('BITLEN',BITLNZ)
      END IF

      RETURN
*-----------------------------------------------------------------------
      ENTRY SZTITS(ITPAT)

      L1=MOD(ITPAT,10)
      L2=MOD(ITPAT/10,10)
      L3=MOD(ITPAT/100,10)
      LP=MOD(ITPAT,1000)
      LC=ITPAT/1000

      LUNDF=.FALSE.
      LRTRN=.FALSE.
      IF (0.LE.L3 .AND. L3.LE.6) THEN
        IF (L1.EQ.0) THEN
          LRTRN=.TRUE.
        ELSE IF (L1.GT.5) THEN
          LUNDF=.TRUE.
        END IF
        IF (L2.EQ.0) THEN
          L2=1
        ELSE IF (L2.GT.5) THEN
          LUNDF=.TRUE.
        END IF
      END IF
      IF (7.LE.L3 .AND. L3.LE.8) THEN
        LUNDF=.TRUE.
      END IF
      IF (L3.EQ.9) THEN
        IF (LP.NE.999) THEN
          LUNDF=.TRUE.
        END IF
      END IF

      IF (LUNDF) THEN
        CMSG='PATTERN NUMBER ### IS NOT DEFINED.'
        WRITE(CMSG(16:18),'(I3)') LP
        CALL MSGDMP('M','SZTNSR',CMSG)
        LRTRN=.TRUE.
      END IF

      IF (LRTRN) RETURN

      IF (LFRST) THEN
        CALL SGIGET('NBITS',NBITSZ)
        CALL SGRGET('BITLEN',BITLNZ)
        CALL SGRGET('TNBLEN',BITLEN)
        LBITS=NBITSZ.EQ.NBITS
        DO 10 I=1,NPAT
          CALL BITPCI(CPAT(I),IPAT(I))
   10   CONTINUE
        LFRST=.FALSE.
      END IF

      DW=BITLEN*NBITS

      LDBLE=.FALSE.

      IF (L3.EQ.0) THEN
        IL1=(L1+1)/2
        IF (MOD(L1,2).EQ.0) THEN
          RL1=BITLEN/SQRT(2.0)
        ELSE
          RL1=BITLEN
        END IF
        IROTA=45*MOD(L1+1,2)
        RSPCE=RL1*NBITS/IL1
        ITYPE=IPAT(IL1)
        INDEX=LC*10+L2
      ELSE IF (1.LE.L3 .AND. L3.LE.4) THEN
        IF (MOD(L3,2).EQ.0) THEN
          DW=DW/SQRT(2.0)
        END IF
        IROTA=45*(L3-1)
        RSPCE=DW/L1
        ITYPE=1
        INDEX=LC*10+L2
      ELSE IF (5.LE.L3 .AND. L3.LE.6) THEN
        LDBLE=.TRUE.
        IF (L3.EQ.5) THEN
          L3=1
        ELSE
          L3=2
        END IF
        IF (MOD(L3,2).EQ.0) THEN
          DW=DW/SQRT(2.0)
        END IF
        IROTA=45*(L3-1)
        RSPCE=DW/L1
        ITYPE=1
        INDEX=LC*10+L2
      ELSE IF (L3.EQ.9) THEN
        IROTA=0
        RSPCE=DW/5
        ITYPE=1
        INDEX=LC*10+5
      END IF

      END
