* PACKAGE     !" $@EyCM@~?^(J, $@%H!<%s(J                      A.Numaguti
*"                              for dcl-5.0 : 95/05/26 S.Takehiro
******************************************************************
      PROGRAM GTCONT
*
#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         !" $@CO?^Ej1F$NIA2h0LCV(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 / 0 /
      REAL       POSI(2), ROTA , MAG       !" $@Ej1FCf?47PEY0^EY(J,$@2sE>(J,$@3HBgN((J
        DATA       POSI, ROTA, MAG/ 180.,0., 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 /
      CHARACTER  MFILE * (NFILN)
        DATA     MFILE  /'coast_world'/
      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 /
      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, MFILE, 
     &                   LAY, WSN, MONO, PRINT,
     &                   STR, END, STEP, EXCH, TLNUM, NOCONT, SOFTF,
     &                   COLOR, CPAT,
     &                   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 ) )
*
      DO 80 ITN = 1, NTMX
         IF ( PAT(ITN) .LT. 0 ) THEN
            NTON = ITN-1
            GOTO 90
         ENDIF
 80   CONTINUE
      NTON = NTMX
 90   CONTINUE
*
      IF ( X.LT.0 .AND. Y.LT.0 .AND. Z.LT.0 ) Z = 0
      IF ( STEP .LE. 1 ) STEP = 1
* 
      IF ( COLOR .GT.1 ) THEN
         CALL GGPSET ( 'NTONE',   COLOR   )
         IF ( CPAT(1) .GT. 0 ) THEN
            CALL GGPSET ( 'TONEPAT', CPAT(1) )
         ENDIF
         IF ( CPAT(2) .GT. 0 ) THEN
            CALL GGPSET ( 'TONEINC', CPAT(2) )
         ELSE IF ( CPAT(2) .LT. 0 ) THEN
            CALL GGPGET ( 'TONEPAT', IPAT1 )
            IF ( -CPAT(2) .GT. 1000 ) THEN
               IPINC = INT((-CPAT(2)-IPAT1)/COLOR/1000) * 1000
            ELSE
               IPINC = INT((-CPAT(2)-IPAT1)/COLOR)
            ENDIF
            CALL GGPSET ( 'TONEINC', IPINC )
         ENDIF
      ENDIF
*
      ALON = POSI(1)               !" $@CO?^Ej1FCf?40LCV(J
      ALAT = POSI(2)
*
*
*"  < 2. $@%G!<%?FI$_9~$_(J, $@2C9)(J >
*
      II = 0
 1100 CONTINUE
         CALL GFBRED               !" $@G\@:EYBP1~FI$_9~$_(J
     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 >
*
               IF(     (PRJ .GE.  5 .AND. PRJ .LE.  7) 
     &             .OR.(PRJ .GE. 10 .AND. PRJ .LE. 13) 
     &             .OR.(PRJ .GE. 20 .AND. PRJ .LE. 23)
     &             .OR.(PRJ .GE. 30 .AND. PRJ .LE. 33) )THEN
                   CALL GGPSET( 'VXMIN', XMIN )
                   CALL GGPSET( 'VXMAX', XMAX )
                   CALL GGPSET( 'VYMIN', YMIN )
                   CALL GGPSET( 'VYMAX', YMAX )
               ENDIF
*
               IF      ( LAY .EQ. 2 ) THEN
                  CALL GGLAY2  ( HHEAD )
               ELSE IF ( LAY .EQ. 3 ) THEN
                  CALL GGLAY3  ( HHEAD )
               ELSE
                  CALL GGLAY1  ( HHEAD )
               ENDIF
*
*"  < 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 GGAXES  ( HHEAD )
*
*"  < 5. $@%H!<%s(J >
*
               IF ( SOFTF ) THEN
                  CALL  SGPSET( 'LSOFTF', .TRUE. )
               ENDIF
               IF ( TLNUM .GE. 0 ) THEN
                  CALL GGPSET  ( 'TLNUM', TLNUM )
               ENDIF
               IF ( COLOR .GT.1 ) THEN
                  CALL GGSTON ( HHEAD, GDATA )
               ENDIF
               IF ( COLOR .GT. 1 .OR. NTON .GE. 1 ) THEN
                  CALL GGTONE  ( HHEAD , GDATA ,
     I                           TONE  , PAT   , NTON  )
               ENDIF
*
*"  < 6. $@%3%s%?!<(J > 
*
               CALL UDPSET  ( 'LABEL',  CLABEL )
               CALL UDPSET  ( 'INDXMJ', CIDX(2) )
               CALL UDPSET  ( 'INDXMN', CIDX(1) )
               IF ( .NOT. NOCONT .AND. (CIDX(1) .GT. 0) ) THEN
                  CALL SGPSET( 'LCLIP', .TRUE. )
                  CALL GGCNTR  ( HHEAD , GDATA )
                  CALL SGPSET( 'LCLIP', .FALSE. )
               ENDIF
*
*"  < 7. $@CO?^(J, $@0^EY7PEY@~(J > 
*
               IF ( MAP .GE.1  ) THEN
                  CALL GGMAPS( MFILE )
               ENDIF
               IF(     (PRJ .GE. 10 .AND. PRJ .LE. 13) 
     &             .OR.(PRJ .GE. 20 .AND. PRJ .LE. 23)
     &             .OR.(PRJ .GE. 30 .AND. PRJ .LE. 33) )THEN
                  CALL UMPGRD
               ENDIF
*
            ENDIF
      GOTO 1100
         ENDIF
*
      CALL GFCLSE ( IFILE )
*
      CALL GGCLSE
*
      STOP
      END
