* PACKAGE GTSCAT    !"  $B;6I[?^(B                        A.Numaguti
*"                             for dcl-5.0 : 95/05/31 S.Takehiro 
*"                             miner bugfix: 96/09/06 S.Takehiro
*******************************************************************
      PROGRAM    GTSCAT
*
#ifdef SYS_IBMS
      INCLUDE    (GTSINC)
      INCLUDE    (GZSIZE)
#else
#include         "gtsinc.F"
#include         "gzsize.F"
#endif
      PARAMETER  ( NFILE=10, NIDX=24 )
      COMMON     /GMWORK/ MWORK
      REAL       MWORK  ( IJKDIM )
*
      CHARACTER  HHEAD ( NDC )*(NCC)
      REAL       GDATA ( IJKDIM )
      CHARACTER  HHEADX( NDC )*(NCC)
      REAL       GDATAX( IJKDIM )
*
      INTEGER    IFILE( NFILE )
      DATA       IFILE / 50,51,52,53,54,55,56,57,58,59 /
      PARAMETER  (NFM1=NFILE-1)
      CHARACTER  HFILE( NFILE ) *(NFILN)
      DATA       HFILE / '$GTTMPDIR/gtool.out',NFM1*' ' /
*
      INTEGER    X, Y, Z
      DATA       X, Y, Z / 3*-1 /
      INTEGER    OVERLAY
      DATA       OVERLAY / 1 /
      CHARACTER  MTITEM  *(NCC)
      DATA       MTITEM / 'ITEM' /
      LOGICAL    MTITL
      DATA       MTITL  / .TRUE. /
      REAL       DIVX  ( 2 )
      DATA       DIVX  / -999.,-999. /
      REAL       DIVY  ( 2 )
      DATA       DIVY  / -999.,-999. /
      REAL       RANGEX( 2 )
      DATA       RANGEX/ -999.,-999. /
      REAL       RANGEY( 2 )
      DATA       RANGEY/ -999.,-999. /

      PARAMETER  (NIDM1=NIDX-1,NIDM4=NIDX-4,NIDM12=NIDX-12)
      INTEGER    MIDX( NIDX ), MTYPE( NIDX )
      DATA       MIDX  / 2,NIDM1*-1 / 
      DATA       MTYPE / 1,2,3,4,5,6,7,8,9,10,11,12,NIDM12*-1 /
      DATA       RSIZE / 0.005 /
      INTEGER    LAY
      DATA       LAY / 1 /
      INTEGER    WSN
      DATA       WSN / 0 /
      LOGICAL    MONO, PRINT
      DATA       MONO, PRINT / 2*.FALSE. /
      CHARACTER  PS   *(NFILN)
      DATA       PS  / '$GTTMPDIR/sgks.ps' /
      LOGICAL    TICK , ATTL
      DATA       TICK , ATTL / .FALSE., .TRUE. /
      INTEGER    STR, END, STEP
      DATA       STR, END, STEP / 1, 999999, 1 /
      LOGICAL    EXCH
      DATA       EXCH  /.FALSE./
      INTEGER    STYPEX
      DATA       STYPEX / 0 /
      INTEGER    STYPEY
      DATA       STYPEY / 0 /
      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/  X, Y, Z, DIVX, DIVY, RANGEX, RANGEY,
     &                   OVERLAY, MIDX, MTYPE, MTITEM, MTITL, RSIZE,
     &                   LAY , WSN,  MONO, PRINT, PS, TICK, ATTL,
     &                   STR, END, STEP, EXCH , STYPEX, STYPEY,
     &                   ITEM, UNIT, TITLE, DSET, EDIT, ETTL, GRESET,
     &                   HELP, HFILE
*
      CALL OPTARG ( 91, 'OPTION', 'HFILE', NOPT, NFILES )
      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 GTSIZE ( HHEADX, IJKDIM )
      CALL GMSIZE ( IJKDIM  )
*
      IF ( WSN .LE. 0 ) THEN
         IF ( PRINT ) THEN
            WSN = 2
            IF ( PS .NE. ' ' ) THEN
               CALL GUNENV( PS, '.', .FALSE. )
               CALL SWCSET( 'PSFILE', PS     )
               IP=LENC(PS)
               WRITE (6,*) 'ps='//PS(1:IP)
            ENDIF
         ELSE
            WSN = 1
         ENDIF
      ENDIF
      CALL GGOPEN ( WSN )
*
      NFL = 1
      IF( NFILES .EQ. 0 ) NFILES = 1 
      DO 300 IFL = 1, NFILES
         IF ( HFILE(IFL) .NE. ' ' ) THEN
            CALL GFROPN ( IFILE(IFL), HFILE(IFL) )
            NFL = IFL
         ENDIF
 300  CONTINUE
*
      OVERLAY = MAX( OVERLAY, NFL )
      STEP    = MAX( STEP, 1 )
*
      NMIDX  = 1
      NMTYPE = 1
      DO 500 ID = 1, NIDX
         IF ( MIDX(ID)  .NE. -1 ) NMIDX  = ID
         IF ( MTYPE(ID) .NE. -1 ) NMTYPE = ID
 500  CONTINUE
*
      IF ( BITLEN .GT. 0 ) THEN
         CALL SGPSET( 'BITLEN', BITLEN )
      ENDIF
      CALL CUPPER( MTITEM )
      CALL GGCSET( 'LTITEM', MTITEM )
      CALL GGPSET( 'LLINT' , MTITL )
*
      II  = 0
      IID = 0
 1100 CONTINUE
         IFILEX = IFILE( MOD(II,NFL)+1 )
         CALL GFREAD
     O            ( HHEAD , GDATA , IEOD  ,
     I              IFILEX, 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 ( Z .EQ. 0 ) THEN
                  CALL GMZAVG
     M               ( HHEAD , GDATA ,
     I                 'ZM'  , 'vert mean'  )
               ELSE IF ( Z .GT. 0 ) THEN 
                  CALL GMZSEL
     M               ( HHEAD , GDATA , Z ,
     I                 '  '  , '  '        )
               ENDIF
               IF ( Y .EQ. 0 ) THEN
                  CALL GMYAVG
     M               ( HHEAD , GDATA ,
     I                 'YM'  , 'merid mean' )
               ELSE IF ( Y .GT. 0 ) THEN 
                  CALL GMYSEL
     M               ( HHEAD , GDATA , Y ,
     I                 '  '  , '  '         )
               ENDIF
               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                 '  '  , '  '        )
               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
*
               IF ( MOD(II-1,NFL) .EQ. 0 ) THEN
                  CALL GPFSET( HHEAD, GDATA,' ',' ', HHEADX, GDATAX )
                  IF ( STYPEX .NE. 0 ) THEN
                     CALL GHPSET ( HHEADX, 'STYP', STYPEX )
                  ENDIF
                  IF ( DIVX( 1 ) .GT. 0. ) THEN
                     CALL GHPSET( HHEADX, 'DIVS', DIVX( 1 ) )
                  ENDIF
                  IF ( DIVX( 2 ) .GT. 0. ) THEN
                     CALL GHPSET( HHEADX, 'DIVL', DIVX( 2 ) )
                  ENDIF
                  IF ( RANGEX(1) .NE. -999. ) THEN
                     CALL GHPSET( HHEADX, 'DMIN', RANGEX(1) )
                  ENDIF
                  IF ( RANGEX(2) .NE. -999. ) THEN
                     CALL GHPSET( HHEADX, 'DMAX', RANGEX(2) )
                  ENDIF
                  IF ( II .LT. END ) GOTO 1100
*
               ELSE
                  IID = IID + 1
                  IF ( STYPEY .NE. 0 ) THEN
                     CALL GHPSET ( HHEAD, 'STYP', STYPEY )
                  ENDIF
                  IF ( DIVY( 1 ) .GT. 0. ) THEN
                     CALL GHPSET( HHEAD, 'DIVS', DIVY( 1 ) )
                  ENDIF
                  IF ( DIVY( 2 ) .GT. 0. ) THEN
                     CALL GHPSET( HHEAD, 'DIVL', DIVY( 2 ) )
                  ENDIF
                  IF ( RANGEY(1) .NE. -999. ) THEN
                     CALL GHPSET( HHEAD, 'DMIN', RANGEY(1) )
                  ENDIF
                  IF ( RANGEY(2) .NE. -999. ) THEN
                     CALL GHPSET( HHEAD, 'DMAX', RANGEY(2) )
                  ENDIF
               ENDIF
*
               IF ( MOD(IID-1,OVERLAY) .EQ. 0 ) THEN
                  IF      ( LAY .EQ. 2 ) THEN
                     CALL GGLAY2  ( HHEADX )
                  ELSE IF ( LAY .EQ. 3 ) THEN
                     CALL GGLAY3  ( HHEADX )
                  ELSE
                     CALL GGLAY1  ( HHEADX )
                  ENDIF
                  IF ( .NOT. TICK ) THEN
                     CALL GGCSET( 'CXSIDET', ' ' )
                     CALL GGCSET( 'CYSIDET', ' ' )
                  ENDIF
                  IF ( .NOT. ATTL ) THEN
                     CALL GGCSET( 'CXSIDEL', ' ' )
                     CALL GGCSET( 'CYSIDEL', ' ' )
                  ENDIF
               ENDIF
*
               MI = MOD( IID-1,OVERLAY )+1
               MIDXS = MIDX ( MOD( MI-1,NMIDX  )+1 )
               MTYPS = MTYPE( MOD( MI-1,NMTYPE )+1 )
*
               IF ( MIDXS .GT. 0 ) THEN
                  CALL SGSPMI  ( MIDXS )
                  CALL SGSPMT  ( MTYPS )
                  CALL SGSPMS  ( RSIZE )
                  IF ( .NOT. EXCH ) THEN
                     CALL GGSCAT  ( HHEADX, GDATAX,
     &                              HHEAD , GDATA , 'Y' )
                  ELSE
                     CALL GGSCAT  ( HHEAD , GDATA ,
     &                              HHEADX, GDATAX, 'X' )
                  ENDIF
               ENDIF
*
            ENDIF
            IF ( II .LT. END ) GOTO 1100
         ENDIF
*
      CALL GGCLSE
*
      STOP
      END
