* PACKAGE     !" $@CO?^>e$N%a%C%7%e(J     93/05/07 S.Takehiro
*
*"$@MzNr(J  93/09/15(takepiro) $@G\@:EYBP1~(J
******************************************************************
      PROGRAM GTMESH
*
#ifdef SYS_IBMS
      INCLUDE    (GTSINC)
      INCLUDE    (GZSIZE)
#else
#include         "gtsinc.F"
#include         "gzsize.F"
#endif
      COMMON     /GMWORK/ MWORK
      REAL       MWORK  ( IJKDIM )
*
      CHARACTER  HHEAD ( NDC )*(NCC)
      REAL       GDATA ( IJKDIM )
*
      PARAMETER  ( NTMX=20 )
      DATA       IFILE / 50 /
      CHARACTER  HFILE( 1 )  *(NFILN)
      DATA       HFILE / 'gtool.out' /
*
      REAL      XMIN, XMAX, YMIN, YMAX   !" $@IA2h0LCV(J
        DATA   XMIN, XMAX  / 0.2,  0.8 /
        DATA   YMIN, YMAX  / 0.10, 0.55 /
      REAL      TXLOC, TYLOC, TXWDH, TYWDH     !" $@%H!<%s%9%1!<%k0LCV(J, $@I}(J
        DATA   TXLOC, TYLOC  / 0.05, 0.05  /
        DATA   TXWDH, TYWDH  / 0.25, 0.025 /
*
      REAL      ALAT, ALON               !" $@Ej1FCf?40^EY7PEY(J
*
*" [$@%*%W%7%g%s(J]
*
      INTEGER    PRJ                       !" $@Ej1FK!(J
        DATA       PRJ / 10 /
      REAL       POSI(2), ROTA , MAG       !" $@Ej1FCf?47PEY0^EY(J,$@2sE>(J,$@3HBgN((J
        DATA       POSI, ROTA, MAG/ 0., 180., 0., 1./
      INTEGER    X, Y, Z
        DATA       X, Y, Z / 3*-1 /
      REAL       CONT  ( 2 )
        DATA       CONT  / -999.,-999. /
      INTEGER    CCYCLE
        DATA       CCYCLE / 5 /
      REAL       RANGE ( 2 )
        DATA       RANGE / -999.,-999. /
      INTEGER    CIDX ( 2 )
        DATA       CIDX  / 1, 3 /
      LOGICAL    CLABEL
        DATA       CLABEL / .TRUE. /
      REAL       TONE ( NTMX+1 )
        DATA       TONE / -999.,NTMX*-999. /
      INTEGER    PAT  ( NTMX )
        DATA       PAT  / NTMX*-1 /
      INTEGER    MAP , MAPIDX
        DATA       MAP , MAPIDX / 0, 1 /
      INTEGER    WSN
        DATA       WSN / 0 /
      LOGICAL    MONO, PRINT
        DATA       MONO, PRINT / 2*.FALSE. /
      INTEGER    LAY
        DATA       LAY / 1 /
      INTEGER    STR, END, STEP
        DATA       STR, END, STEP / 1, 999999, 1 /
      LOGICAL    EXCH
        DATA       EXCH  /.FALSE./
      INTEGER    COLOR
        DATA       COLOR / 0 /
      INTEGER    CPAT ( 2 )
        DATA       CPAT / 18999, -99999 /
      INTEGER    PIXEL ( 2 )
        DATA       PIXEL / -1, -1 /
      LOGICAL    NOCONT
        DATA       NOCONT /.FALSE./
      LOGICAL    SOFTF
        DATA       SOFTF /.FALSE./
      INTEGER    TLNUM
        DATA       TLNUM / 6 /
      CHARACTER  ITEM   *(NCC)
      CHARACTER  UNIT   *(NCC)
      CHARACTER  TITLE  *(NCC*2)
      CHARACTER  DSET   *(NCC)
      CHARACTER  EDIT   *(NCC)
      CHARACTER  ETTL   *(NCC)
        DATA       ITEM, UNIT, TITLE, DSET, EDIT, ETTL /6*' '/
      LOGICAL    GRESET
        DATA       GRESET / .FALSE. /
      LOGICAL    HELP
        DATA       HELP   / .FALSE. /
*
      NAMELIST /OPTION/  PRJ, POSI, ROTA, MAG, 
     &                   X, Y, Z,
     &                   CONT, CCYCLE, RANGE, CIDX, CLABEL, 
     &                   TONE, PAT, MAP, MAPIDX, LAY, WSN, MONO, PRINT,
     &                   STR, END, STEP, EXCH, TLNUM, NOCONT, SOFTF,
     &                   COLOR, CPAT, PIXEL,
     &                   ITEM, UNIT, TITLE, DSET, EDIT, ETTL, GRESET,
     &                   HELP, HFILE
*
*" < 1. $@%3%^%s%I%i%$%s2r@O(J >
*
      CALL OPTARG ( 91, 'OPTION', 'HFILE', NOPT, NFILE )
      READ (91,OPTION,IOSTAT=IOS)
      CLOSE(91)
      IF ( IOS.NE.0 .OR. HELP ) THEN
         WRITE(6,OPTION)
         STOP
      ENDIF
*
      CALL GTOPEN
      CALL GTSIZE ( HHEAD , IJKDIM )
      CALL GMSIZE ( IJKDIM  )
*
      IF ( WSN .LE. 0 ) THEN
         IF ( PRINT ) THEN
            WSN = 2
         ELSE
            WSN = 1
         ENDIF
      ENDIF
*
      CALL GGOPEN ( WSN )
*
*" $@IA2h0LCV@_Dj(J
*
      CALL GGPSET( 'TXSLOC', TXLOC )
      CALL GGPSET( 'TYSLOC', TYLOC )
      CALL GGPSET( 'TXSWDH', TXWDH )
      CALL GGPSET( 'TYSWDH', TYWDH )
*
      CALL GFROPN ( IFILE, HFILE( 1 ) )
*
      IF ( X.LT.0 .AND. Y.LT.0 .AND. Z.LT.0 ) Z = 0
      IF ( STEP .LE. 1 ) STEP = 1
* 
*"  < 2. $@%G!<%?FI$_9~$_(J, $@2C9)(J >
*
      II = 0
 1100 CONTINUE
         CALL GFBRED
     O            ( HHEAD , GDATA , IEOD  ,
     I              IFILE , 1               )
*
         IF ( IEOD .EQ. 0 ) THEN
*
            II = II + 1
            IF ( ( II.GE.STR ).AND.( II.LE.END ).AND.
     &           ( MOD( II-STR,STEP ).EQ.0 )          ) THEN         
*
               IF      ( X .EQ. 0 ) THEN
                  CALL GMXAVG
     I            ( HHEAD , GDATA ,
     I              'XM'  , 'zonal mean'  )
               ELSE IF ( X .GT. 0 ) THEN
                  CALL GMXSEL
     I            ( HHEAD , GDATA , X   ,
     I              '  '  , ' '           )
               ELSE IF ( Y .EQ. 0 ) THEN
                  CALL GMYAVG
     I            ( HHEAD , GDATA ,
     I              'YM'  , 'merid mean'  )
               ELSE IF ( Y .GT. 0 ) THEN
                  CALL GMYSEL
     I            ( HHEAD , GDATA , Y   ,
     I              '  '  , '  '          )
               ELSE IF ( Z .EQ. 0 ) THEN
                  CALL GMZAVG
     I            ( HHEAD , GDATA ,
     I              'ZM'  , 'vert mean'   )
               ELSE IF ( Z .GT. 0 ) THEN
                  CALL GMZSEL
     I            ( HHEAD , GDATA , Z  ,
     I              ' '   , ' '           )
               ENDIF
*
               CALL GMXCYC
     I            ( HHEAD , GDATA )
*
               IF ( EXCH ) THEN
                  CALL GMEYXZ
     I            ( HHEAD , GDATA ,
     I              '  ' , '  '  )
               ENDIF
*
               IF ( ITEM .NE. ' ' ) THEN
                  CALL GHCSET( HHEAD , 'ITEM', ITEM )
               ENDIF
               IF ( UNIT .NE. ' ' ) THEN
                  CALL GHCSET( HHEAD , 'UNIT', UNIT )
               ENDIF
               IF ( TITLE .NE. ' ' ) THEN
                  CALL GHCSTS( HHEAD , 'TITL', TITLE )
               ENDIF
               IF ( DSET .NE. ' ' ) THEN
                  CALL GHCSET( HHEAD , 'DSET', DSET )
               ENDIF
               IF ( GRESET ) THEN
                  CALL GHRSGP( HHEAD  )
               ENDIF
*
               CALL GGPSET( 'ICYCLE', CCYCLE )
               IF ( CONT(1) .GT. 0. ) THEN
                  CALL GHPSET( HHEAD, 'DIVS', CONT(1) )
               ENDIF
               IF ( CONT(2) .GT. 0. ) THEN
                  CALL GHPSET( HHEAD, 'DIVL', CONT(2) )
               ENDIF
               IF ( RANGE(1) .NE. -999. ) THEN
                  CALL GHPSET( HHEAD, 'DMIN', RANGE(1) )
               ENDIF
               IF ( RANGE(2) .NE. -999. ) THEN
                  CALL GHPSET( HHEAD, 'DMAX', RANGE(2) )
               ENDIF
*
*"  < 3. $@I=Bj(J, $@<4(J >
*
               CALL GGPSET( 'VXMIN', XMIN )
               CALL GGPSET( 'VXMAX', XMAX )
               CALL GGPSET( 'VYMIN', YMIN )
               CALL GGPSET( 'VYMAX', YMAX )
*
               IF      ( LAY .EQ. 2 ) THEN
                  CALL GGLAY2  ( HHEAD )
               ELSE IF ( LAY .EQ. 3 ) THEN
                  CALL GGLAY3  ( HHEAD )
               ELSE
                  CALL GGLAY1  ( HHEAD )
               ENDIF
*
               ALON = POSI(1)
               ALAT = POSI(2)
*
*
*"  < 4. $@CO?^Ej1F(J >
*
               CALL GGPSET( 'MAPPRJ', PRJ  )
               CALL GGPSET( 'MAPLAT', ALAT )
               CALL GGPSET( 'MAPLON', ALON )
               CALL GGPSET( 'MAPROT', ROTA )
               CALL GGPSET( 'MAPFAC', MAG )
*
               CALL GGPSET( 'VXMIN' , XMIN )
               CALL GGPSET( 'VXMAX' , XMAX )
               CALL GGPSET( 'VYMIN' , YMIN )
               CALL GGPSET( 'VYMAX' , YMAX )
*     
               CALL GGMAXS  ( HHEAD )
*
            ENDIF
      GOTO 1100
         ENDIF
*
      CALL GFCLSE ( IFILE )
*
      CALL GGCLSE
*
      STOP
      END
**********************************************************************
      SUBROUTINE GGMAXS
     I         ( HHEAD )
*
      CHARACTER  HHEAD ( * )*(*)         !" $@%X%C%@!<(J
*
#ifdef SYS_IBMS
      INCLUDE    (GZSIZE)                !" NCC, NDC
      INCLUDE    (GZIWRK)                !" NW: $@<4%o!<%/$NBg$-$5(J
#else
#include         "gzsize.F"              !" NCC, NDC
#include         "gziwrk.F"              !" NW: $@<4%o!<%/$NBg$-$5(J
#endif
      CHARACTER  HHEADX( NDC )*(NCC)     !" X $@<4%U%!%$%k$N%X%C%@!<(J
      CHARACTER  HHEADY( NDC )*(NCC)     !" Y $@<4%U%!%$%k$N%X%C%@!<(J
      REAL       AXISX ( NW )            !" X $@:BI8CM(J
      REAL       AXISY ( NW )            !" Y $@:BI8CM(J
      LOGICAL    OSUBCK
*
      REAL       XMIN , XMAX , YMIN , YMAX     !" $@IA2hMQJQ?t(J
      REAL       DMINX, DMAXX, DMINY, DMAXY    !" $@IA2hMQJQ?t(J
      REAL       RADI                          !" NC $@>e$NCO5eH>7B(J
      REAL       RADW                          !" WC $@>e$NCO5eH>7B(J
*
      INTEGER    IPRJ                      !" $@Ej1FK!(J
      REAL       ALAT, ALON                !" $@Ej1FCf?40^EY79EY(J
      REAL       ROTA                      !" $@2sE>(J
      REAL       MAG                       !" $@Ej1F3HBgN((J
      CHARACTER  HPOS*30, HLAT*8, HLON*8
*
*"         < 1. $@<4%U%!%$%k$NFI$_9~$_(J >
*
      CALL GTPGET ( 'SUBCHK', OSUBCK )
      CALL GTSIZE ( HHEADX  ,  NW     )
      CALL GTSIZE ( HHEADY  ,  NW     )
      CALL GUQAXV
     I            ( HHEAD , 1     , 'LOC' ,
     O              HHEADX, AXISX , IEOD   )
      CALL GUQAXV
     I            ( HHEAD , 2     , 'LOC' ,
     O              HHEADY, AXISY , IEOD   )
      CALL GTPSET ( 'SUBCHK', OSUBCK )
*
*"         < 2. $@HO0O(J >
*
      CALL GHPGET ( HHEAD , 'ASTR1', IXSTR )
      CALL GHPGET ( HHEAD , 'AEND1', IXEND )
      CALL GHPGET ( HHEAD , 'ASTR2', IYSTR )
      CALL GHPGET ( HHEAD , 'AEND2', IYEND )
*
      CALL GHPGET ( HHEADX , 'DMIN' , DMINX )
      CALL GHPGET ( HHEADX , 'DMAX' , DMAXX )
      CALL GHPGET ( HHEADY , 'DMIN' , DMINY )
      CALL GHPGET ( HHEADY , 'DMAX' , DMAXY )
*
*"         < 3. $@:BI8$N@_Dj(J >
*
      CALL UWSGXA ( AXISX, IXEND-IXSTR+1 )
      CALL UWSGYA ( AXISY, IYEND-IYSTR+1 )
*
*"         < 4. $@CO?^IA2h@_Dj(J >
*
      CALL GGPGET( 'MAPPRJ', IPRJ )
      CALL GGPGET( 'MAPLON', ALON )
      CALL GGPGET( 'MAPLAT', ALAT )
      CALL GGPGET( 'MAPROT', ROTA )
      CALL GGPGET( 'MAPFAC', MAG  )
*
      CALL GGPGET( 'VXMIN', XMIN )
      CALL GGPGET( 'VXMAX', XMAX )
      CALL GGPGET( 'VYMIN', YMIN )
      CALL GGPGET( 'VYMAX', YMAX )
*
      IF( ( 5 .LE. IPRJ ) .AND. ( IPRJ .LE. 6 ) )THEN
         CALL GHPGET ( HHEADX , 'DMAX' , RADW )
         RADI = MIN( XMAX-XMIN, YMAX-YMIN ) / 2. * 0.9 * MAG / RADW
      ELSEIF( ( 10 .LE. IPRJ ) .AND. ( IPRJ .LE. 33 ) )THEN
         RADI = MIN( XMAX-XMIN, YMAX-YMIN ) / 2. * 0.9 * MAG
      ENDIF
*
      CALL SGPSET('LDEG', .TRUE.)    !" $@3QEYC10L(J
      CALL SGPSET('LLNINT',.TRUE.)
      CALL SGPSET('LGCINT',.TRUE.)
*
      CALL SGSCLP(0)
      IF( ( 5 .LE. IPRJ ) .AND. ( IPRJ .LE. 7 ) )THEN
         CALL SGSSIM( RADI, 0., 0. )
      ELSEIF( ( 10 .LE. IPRJ ) .AND. ( IPRJ .LE. 33 ) )THEN
         IF( IPRJ .NE. 30 )THEN
            RADI = RADI / 2.5
         ENDIF
         CALL SGSSIM( RADI, 0., 0. )
         CALL SGSMPL( ALON, ALAT, ROT )
      ENDIF
*
      CALL SGSWND( DMINX, DMAXX, DMINY, DMAXY )      
      CALL SGSVPT( XMIN , XMAX , YMIN , YMAX  )
      CALL SGSTRN(IPRJ)
      CALL SGSTRF
*
*"         < 5. $@Ej1FCf?40LCV$NI=<((J > 
*
      CALL GGPGET( 'SEDIT' , SEDIT )
c$$$      CALL UZPSET( 'RSIZEC1', SEDIT )
*
      CALL CHVAL( '(F6.1)', ALON, HLON )
      IHLON = LENC( HLON )
      CALL CHVAL( '(F5.1)', ALAT, HLAT )
      IHLAT = LENC( HLAT )
      HPOS = '(lon,lat)=(' // HLON(1:IHLON) // ', '
     &                              // HLAT(1:IHLAT) // ')'
      IHPOS = LENC(HPOS)
*
      XP = ( XMIN + XMAX ) / 2
      YP = YMIN - SEDIT * 1.2
      CALL SGTXZV( XP , YP , HPOS(1:IHPOS), SEDIT, 0, 0, 3 )
c$$$      CALL UXSTTL( 'T', HPOS(1:IHPOS) ,0 )
*
*"         < 6. $@0^EY7PEY@~$N=q$-9~$_(J > 
*
      CALL SGSCLP(1)
      IF( ( 5 .LE. IPRJ ) .AND. ( IPRJ .LE. 7 ) )THEN
         CALL DMESH
     I             ( HHEADX , AXISX ,
     I               HHEADY , AXISY   )
*
      ELSE IF( ( 10 .LE. IPRJ ) .AND. ( IPRJ .LE. 33 ) )THEN
         CALL DLINE
     I             ( HHEADX , AXISX ,
     I               HHEADY , AXISY   )
      ENDIF
      CALL SGSCLP(0)
*
      RETURN
      END
**********************************************************************
      SUBROUTINE DMESH                    !" $@30OH0O$_(J($@6K:BI8(J)
     I             ( HHEADX , AXISX ,
     I               HHEADY , AXISY   )
*
#ifdef SYS_IBMS
      INCLUDE    (GTSINC)
      INCLUDE    (GZSIZE)
#else
#include         "gtsinc.F"
#include         "gzsize.F"
#endif
*
      REAL       AXISX(*)                !" X $@:BI8CM(J
      REAL       AXISY(*)                !" Y $@:BI8CM(J
*
      CHARACTER  HHEADX( NDC )*(NCC)     !" $@F07B<4%X%C%@!<%U%!%$%k(J
      CHARACTER  HHEADY( NDC )*(NCC)     !" $@J}0L3Q<4%X%C%@!<%U%!%$%k(J
      CHARACTER  HDSETY*(NCC)
*
      INTEGER    IXSTR, IXEND            !" $@:BI83J;RE@HO0O(J(X)
      INTEGER    IYSTR, IYEND            !" $@:BI83J;RE@HO0O(J(Y)
*
      REAL  X(IJKDIM) , Y(IJKDIM)
*
      CALL GHPGET ( HHEADX, 'ASTR1', IXSTR )
      CALL GHPGET ( HHEADX, 'AEND1', IXEND )
      CALL GHPGET ( HHEADY, 'ASTR1', IYSTR )
      CALL GHPGET ( HHEADY, 'AEND1', IYEND )
*
      CALL GHCGET ( HHEADY , 'DSET' , HDSETY )
*
      NX = IXEND - IXSTR + 1
      IF ( HDSETY(1:1) .EQ. 'C' )THEN
         NY = IYEND - IYSTR + 2
      ELSE
         NY = IYEND - IYSTR + 1
      ENDIF
*
      DO 100 I = 1, NX
         DO 110 J = 1, NY
            X(J) = AXISX(IXSTR+I-1)
            Y(J) = AXISY(IYSTR+J-1)
 110     CONTINUE 
         CALL SGPLZU( NY, X, Y, 1, 1 )
 100  CONTINUE 
*     
      DO 200 J = 1, NY
         DO 210 I = 1, NX
            X(I) = AXISX(IXSTR+I-1)
            Y(I) = AXISY(IYSTR+J-1)
 210     CONTINUE 
         CALL SGPLZU( NX, X, Y, 1, 1 )
 200  CONTINUE 
*     
      RETURN
      END
**********************************************************************
      SUBROUTINE DLINE
     I             ( HHEADX , AXISX ,
     I               HHEADY , AXISY   )
*
*
#ifdef SYS_IBMS
      INCLUDE    (GTSINC)
      INCLUDE    (GZSIZE)
#else
#include         "gtsinc.F"
#include         "gzsize.F"
#endif
*
      REAL       AXISX(*)                !" X $@:BI8CM(J
      REAL       AXISY(*)                !" Y $@:BI8CM(J
*
      CHARACTER  HHEADX( NDC )*(NCC)     !" $@F07B<4%X%C%@!<%U%!%$%k(J
      CHARACTER  HHEADY( NDC )*(NCC)     !" $@J}0L3Q<4%X%C%@!<%U%!%$%k(J
      CHARACTER  HDSETX*(NCC)
*
      DIMENSION X(IJKDIM), Y(IJKDIM)
*
      INTEGER    IXSTR, IXEND            !" $@:BI83J;RE@HO0O(J(X)
      INTEGER    IYSTR, IYEND            !" $@:BI83J;RE@HO0O(J(Y)
*
      CALL GLPSET('LEPSL', .TRUE.)
*
      CALL GHPGET ( HHEADX, 'ASTR1', IXSTR )
      CALL GHPGET ( HHEADX, 'AEND1', IXEND )
      CALL GHPGET ( HHEADY, 'ASTR1', IYSTR )
      CALL GHPGET ( HHEADY, 'AEND1', IYEND )
*
      CALL GHCGET ( HHEADX , 'DSET' , HDSETX )
*
      IF ( HDSETX(1:1) .EQ. 'C' )THEN
         NX = IXEND - IXSTR + 2
      ELSE
         NX = IXEND - IXSTR + 1
      ENDIF
      NY = IYEND - IYSTR + 1

*     / LONGITUDE LINE /

      DO 100 J=1, NY
        DO 200 I=1, NX
           X(I) = AXISX(IXSTR+I-1)
           Y(I) = AXISY(IYSTR+J-1)
  200   CONTINUE
        CALL SGPLZU(NX, X, Y, 1, 1)
  100 CONTINUE

*     / LATITUDE LINE /

      DO 300 I=1, NX
         DO 400 J=1, NY
           X(J) = AXISX(IXSTR+I-1)
           Y(J) = AXISY(IYSTR+J-1)
 400    CONTINUE
        CALL SGPLZU(NY, X, Y, 1, 1)
 300  CONTINUE

      RETURN
      END
