*"$BI=Bj(B $B%H!<%s%9%1!<%k(B  GTOOL3(GGTONS)
*
*"$BMzNr(B 90/10/01 $B>B8}(B  $BFX(B
*"     92/07/08 $B>B8}(B  $BFX(B
*"     95/05/26 $BC]9-??0l(B for dcl-5.z.7
*"     96/01/10 $BC]9-??0l(B for dcl-5.0
*"     97/12/01 $BC]9-??0l(B SET -> STX
*
*********************************************************************
*"         << $B%H!<%s%9%1!<%k(B >>
*********************************************************************
      SUBROUTINE GGTONS
     I         ( HHEAD )
*
      CHARACTER  HHEAD ( * )*(*)         !" $B%X%C%@!<(B
*
      PARAMETER ( NHC=10, NTONL=10, NTONS=100 )
      CHARACTER  HL  (NTONL)*(NHC)
      REAL       UX2 (NTONL)
      REAL       UX1 (NTONS)
      REAL       UPX ( 4 )
      REAL       UPY ( 4 )
      CHARACTER  CSGI                    !" FUNCTION
*                                                 !" $B@55,2=JQ495-21MQ(B
      INTEGER    ITR                              !" $BJQ49HV9f(B
      REAL       VXMIN , VXMAX , VYMIN , VYMAX    !" $B%S%e!<%]!<%H(B
      REAL       UXMIN , UXMAX , UYMIN , UYMAX    !" 
      REAL       RADI  , VXOFF , VYOFF
      REAL       ALON  , ALAT  , ROT 
      REAL       ROFFXB                           !" $B<4$+$i$N%i%Y%k$N5wN%(B
*
*"         < 1. $B@55,2=JQ49%;!<%V(B >
*
      CALL SGQTRN ( ITR )
      CALL SGQVPT ( VXMIN , VXMAX , VYMIN , VYMAX )
*
      IF ( ( 1. LE. ITR ) .AND. ( ITR .LE. 4 ) ) THEN
         CALL SGQWND ( UXMIN , UXMAX , UYMIN , UYMAX )
      ELSEIF ( ( 5. LE. ITR ) .AND. ( ITR .LE. 6 ) ) THEN
         CALL SGQSIM ( RADI , VXOFF , VYOFF )
      ELSEIF ( ( 10. LE. ITR ) .AND. ( ITR .LE. 33 ) ) THEN
         CALL SGQMPL ( ALON , ALAT , ROT )
      ENDIF
*
      CALL UZPGET ( 'ROFFXB', ROFFXB )
*
*"         < 2. $B%H!<%s%9%1!<%kMQ@55,2=JQ49@_Dj(B >
*
      CALL UEQNTL ( NTON )                            !" $B%H!<%s%l%Y%k?t(B
*
      CALL GGPGET ( 'TXSLOC', VXLOC )                 !" $B%H!<%s%9%1!<%k$N0LCV(B(x)
      CALL GGPGET ( 'TYSLOC', VYLOC )                 !" $B%H!<%s%9%1!<%k$N0LCV(B(y)
      CALL GGPGET ( 'TXSWDH', VXWDH )                 !" $B%H!<%s%9%1!<%k$NI}(B(x)
      CALL GGPGET ( 'TYSWDH', VYWDH )                 !" $B%H!<%s%9%1!<%k$NI}(B(y)
      CALL GGPGET ( 'TLNUM' , ITONL )                 !" $B%H!<%s%i%Y%k$N?t(B
      IF ( ITONL .GT. NTONL ) THEN
         CALL MSGDMP( 'W', 'GGTONS', 'TONE LABEL NUMBER IS REDUCED.' )
         ITONL = NTONL
      ENDIF
      ITONL = MAX( ITONL, 1 )
*
      CALL SGSVPT ( VXLOC , VXLOC+VXWDH ,
     &              VYLOC , VYLOC+VYWDH   )
      CALL SGSWND ( 1.    , REAL(NTON+1), 0.    , 1.  )
      CALL SGSTRN ( 1 )
      CALL SGSTRF
*
      CALL UZPSTX ( 'ROFFXB', 0 )                     !" $B:BI8<4$+$i$N%i%Y%k$N5wN%(B
*
*"         < 3. $B%9%1!<%kIA2h(B >
*
      UPY ( 1 ) = 0.
      UPY ( 2 ) = 1.
      UPY ( 3 ) = 1.
      UPY ( 4 ) = 0.
      DO 3100 IT = 1, NTON
         UPX ( 1 ) = REAL( IT )
         UPX ( 2 ) = REAL( IT )
         UPX ( 3 ) = REAL( IT+1 )
         UPX ( 4 ) = REAL( IT+1 )
         CALL UEQTLV ( TLEV1, TLEV2, IPAT, IT )       !" $B%H!<%s%l%Y%k$NB0@-(B
         CALL SGTNZU ( 4, UPX, UPY,  IPAT )           !" $BH"$NEI$j$D$V$7(B
 3100 CONTINUE
*
*"         < 4. $B%9%1!<%kL\@9(B >
*
      CALL GHPGET ( HHEAD, 'MISS', VMISS )
      CALL GGPGET ( 'SREMK'  , SREMK )                !" $BCm5-J8;z9b$5(B
      CALL UZPSTX ( 'RSIZEL1', SREMK )                !" $B%i%Y%kJ8;z9b$5@_Dj(B
      CALL UZPSTX ( 'INNER'  , 1     )                !" $BFb8~$-$KL\@9$rBG$D(B
*
      IF ( (NTON+1) .GT. NTONS ) THEN
         CALL MSGDMP ( 'W', 'GGTONS', ' TOO MANY TONE LEVEL FOR SCALE' )
      ENDIF
      DO 4100 IT = 1, MIN( NTON+1, NTONS )
         UX1 ( IT ) = REAL ( IT )
 4100 CONTINUE
*
      UX2 (1) = 1.
      CALL UEQTLV ( TLEV1, TLEV2, IPAT, 1 )
      IF ( TLEV1 .NE. VMISS ) THEN
         CALL CHVAL  ( 'D', TLEV1, HL(1) )
      ELSE
         HL(1) = '-'//CSGI(189)                            !" -$B!g(B
      ENDIF
*
      IL = 1
      ITINT = NTON/ITONL + 1
      DO 4200 IT = ITINT+1, NTON-ITINT+1, ITINT
         IL = IL + 1
         UX2 ( IL ) = REAL( IT )
         CALL UEQTLV ( TLEV1, TLEV2, IPAT, IT )
         CALL CHVAL  ( 'D', TLEV1, HL(IL) )
 4200 CONTINUE
*
      IL = IL + 1
      UX2 ( IL ) = REAL( NTON+1 )
      CALL UEQTLV ( TLEV1, TLEV2, IPAT, NTON )
      IF ( TLEV2 .NE. VMISS ) THEN
         CALL CHVAL  ( 'D', TLEV2, HL(IL) )
      ELSE
         HL(IL) = CSGI(189)                                !" $B!g(B
      ENDIF
*
      CALL UXAXLB( 'B', UX1, NTON+1, UX2, HL, NHC, IL )    !" $B:BI8<4$rIA$/(B
*
*"         < 5. $B@55,2=JQ49$rLa$9(B >
*
      CALL SGSVPT ( VXMIN , VXMAX , VYMIN , VYMAX )
*
      IF ( ( 1. LE. ITR ) .AND. ( ITR .LE. 4 ) ) THEN
         CALL SGSWND ( UXMIN , UXMAX , UYMIN , UYMAX )
      ELSEIF ( ( 5. LE. ITR ) .AND. ( ITR .LE. 6 ) ) THEN
         CALL SGSSIM ( RADI , VXOFF , VYOFF )
      ELSEIF ( ( 10. LE. ITR ) .AND. ( ITR .LE. 33 ) ) THEN
         CALL SGSMPL ( ALON , ALAT , ROT )
      ENDIF
*
      CALL SGSTRN ( ITR )
      CALL SGSTRF
*
      CALL UZPSTX ( 'ROFFXB', ROFFXB )
*
      RETURN
      END
