*PACKAGE GTVECT !" ベクトル図                           A.Numaguti
*"                                             95/05/26 S.Takehiro
*"                                             97/12/12 S.Takehiro
******************************************************************
      PROGRAM GTVECT
*
#ifdef SYS_IBMS
      INCLUDE    (GTSINC)
      INCLUDE    (GZSIZE)
#else
#include         "gtsinc.F"
#include         "gzsize.F"
#endif
      COMMON     /GMWORK/ MWORK
      REAL       MWORK  ( IJKDIM )
*
      CHARACTER  HHEADU( NDC )*(NCC)
      REAL       GDATAU( IJKDIM )
      CHARACTER  HHEADV( NDC )*(NCC)
      REAL       GDATAV( IJKDIM )
      CHARACTER  HWRK1 *(NCC)
      CHARACTER  HWRK2 *(NCC)
*
      PARAMETER  ( NTMX=20 )
      DATA       IFILEU / 50 /
      DATA       IFILEV / 51 /
      CHARACTER  HFILE( 2 )  *(NFILN)
      DATA       HFILE / 2*'$GTTMPDIR/gtool.out' /
*
*" [オプション]
*
      INTEGER    X, Y, Z
        DATA       X, Y, Z / 3*-1 /
      INTEGER    INTV ( 2 )
        DATA       INTV / 2*1 /
      REAL       FACT
        DATA       FACT    / 1.0 /
      LOGICAL    EQRAT   
        DATA       EQRAT   / .TRUE. /
      LOGICAL    LUNIT   
        DATA       LUNIT   / .TRUE. /
      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. /
      CHARACTER  PS   *(NFILN)
        DATA       PS     / '$GTTMPDIR/sgks.ps' /
      INTEGER    LAY
        DATA       LAY / 1 /
      INTEGER    STR, END, STEP
        DATA       STR, END, STEP / 1, 999999, 1 / 
      REAL       RANGE ( 2 )
        DATA       RANGE / 2*-999. /
      INTEGER    IDX
        DATA       IDX / 1 /
      LOGICAL    EXCH
        DATA       EXCH  /.FALSE./
      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,
     &                   INTV, FACT, LUNIT, EQRAT, RANGE,
     &                   MAP, MAPIDX, MFILE, 
     &                   LAY, WSN, MONO, PRINT, PS,
     &                   STR, END, STEP, EXCH,
     &                   ITEM, UNIT, TITLE, DSET, EDIT, ETTL, GRESET,
     &                   HELP, HFILE
*
*" < 1. コマンドライン解析 >
*
      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 ( HHEADU, IJKDIM )
      CALL GTSIZE ( HHEADV, 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 )
      CALL GFROPN ( IFILEU, HFILE( 1 ) )
      IF ( HFILE(2) .EQ. HFILE(1) ) THEN
         IFILEV = IFILEU
      ELSE
         CALL GFROPN ( IFILEV, HFILE( 2 ) )
      ENDIF
*
      IF ( X.LT.0 .AND. Y.LT.0 .AND. Z.LT.0 ) Z = 0
      IF ( STEP .LE. 1 ) STEP = 1
*
*"  < 2. データ読み込み, 加工 >
*
      II = 0
 1100 CONTINUE
         CALL GFREAD
     O            ( HHEADU, GDATAU, IEODU ,
     I              IFILEU, 1               )
         CALL GFREAD
     O            ( HHEADV, GDATAV, IEODV ,
     I              IFILEV, 1               )
*
         IF ( MAX(IEODU,IEODV) .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            ( HHEADU, GDATAU,
     I              'XM'  , 'zonal mean'  )
                  CALL GMXAVG
     I            ( HHEADV, GDATAV,
     I              'XM'  , 'zonal mean'  )
               ELSE IF ( X .GT. 0 ) THEN
                  CALL GMXSEL
     I            ( HHEADU, GDATAU, X   ,
     I              '  '  , ' '           )
                  CALL GMXSEL
     I            ( HHEADV, GDATAV, X   ,
     I              '  '  , ' '           )
               ELSE IF ( Y .EQ. 0 ) THEN
                  CALL GMYAVG
     I            ( HHEADU, GDATAU,
     I              'YM'  , 'merid mean'  )
                  CALL GMYAVG
     I            ( HHEADV, GDATAV,
     I              'YM'  , 'merid mean'  )
               ELSE IF ( Y .GT. 0 ) THEN
                  CALL GMYSEL
     I            ( HHEADU, GDATAU, Y   ,
     I              '  '  , '  '          )
                  CALL GMYSEL
     I            ( HHEADV, GDATAV, Y   ,
     I              '  '  , '  '          )
               ELSE IF ( Z .EQ. 0 ) THEN
                  CALL GMZAVG
     I            ( HHEADU, GDATAU,
     I              'ZM'  , 'vert mean'   )
                  CALL GMZAVG
     I            ( HHEADV, GDATAV,
     I              'ZM'  , 'vert mean'   )
               ELSE IF ( Z .GT. 0 ) THEN
                  CALL GMZSEL
     I            ( HHEADU, GDATAU, Z  ,
     I              ' '   , ' '           )
                  CALL GMZSEL
     I            ( HHEADV, GDATAV, Z  ,
     I              ' '   , ' '           )
               ENDIF
*
               CALL GMXCYC
     I            ( HHEADU, GDATAU )
               CALL GMXCYC
     I            ( HHEADV, GDATAV )
*
               IF ( EXCH ) THEN
                  CALL GMEYXZ
     I            ( HHEADU, GDATAU,
     I              '  ' , '  '  )
                  CALL GMEYXZ
     I            ( HHEADV, GDATAV,
     I              '  ' , '  '  )
               ENDIF
*
               IF ( ITEM .NE. ' ' ) THEN
                  CALL GHCSET( HHEADU, 'ITEM', ITEM )
               ELSE
                  CALL GHCGET( HHEADU, 'ITEM', HWRK1 )
                  CALL GHCGET( HHEADV, 'ITEM', HWRK2 )
                  IF ( HWRK1 .NE. HWRK2 ) THEN
                     I1 = LENC(HWRK1)
                     I2 = LENC(HWRK1)
                     CALL GHCSET( HHEADU, 'ITEM', 
     &                            HWRK1(1:I1)//'-'//HWRK2(1:I2) )
                  ENDIF
               ENDIF
               IF ( UNIT .NE. ' ' ) THEN
                  CALL GHCSET( HHEADU, 'UNIT', UNIT )
               ELSE
                  CALL GHCGET( HHEADU, 'UNIT', HWRK1 )
                  CALL GHCGET( HHEADV, 'UNIT', HWRK2 )
                  IF ( HWRK1 .NE. HWRK2 ) THEN
                     I1 = LENC(HWRK1)
                     I2 = LENC(HWRK1)
                     CALL GHCSET( HHEADU, 'UNIT', 
     &                            HWRK1(1:I1)//'-'//HWRK2(1:I2) )
                  ENDIF
               ENDIF
               IF ( TITLE .NE. ' ' ) THEN
                  CALL GHCSTS( HHEADU, 'TITL', TITLE )
               ELSE
                  CALL GHCGET( HHEADU, 'TITL1', HWRK1 )
                  CALL GHCGET( HHEADV, 'TITL1', HWRK2 )
                  IF ( HWRK1 .NE. HWRK2 ) THEN
                     I1 = LENC(HWRK1)
                     I2 = LENC(HWRK1)
                     CALL GHCSTS( HHEADU, 'TITL', 
     &                            HWRK1(1:I1)//'-'//HWRK2(1:I2) )
                  ENDIF
               ENDIF
               IF ( DSET .NE. ' ' ) THEN
                  CALL GHCSET( HHEADU, 'DSET', DSET )
               ELSE
                  CALL GHCGET( HHEADU, 'DSET', HWRK1 )
                  CALL GHCGET( HHEADV, 'DSET', HWRK2 )
                  IF ( HWRK1 .NE. HWRK2 ) THEN
                     I1 = LENC(HWRK1)
                     I2 = LENC(HWRK1)
                     CALL GHCSET( HHEADU, 'DSET', 
     &                            HWRK1(1:I1)//'-'//HWRK2(1:I2) )
                  ENDIF
               ENDIF
*
               IF ( GRESET ) THEN
                  CALL GHRSGP( HHEADU  )
                  CALL GHRSGP( HHEADV  )
               ENDIF
*
               IF ( RANGE(1) .NE. -999. ) THEN
                  CALL GHPSET( HHEADU, 'DMIN', 0.       )
                  CALL GHPSET( HHEADU, 'DMAX', RANGE(1) )
               ENDIF
               IF ( RANGE(2) .NE. -999. ) THEN
                  CALL GHPSET( HHEADV, 'DMIN', 0.       )
                  CALL GHPSET( HHEADV, 'DMAX', RANGE(2) )
               ENDIF
*
*"  < 3. 表題 >
*
               IF      ( LAY .EQ. 2 ) THEN
                  CALL GGLAY2  ( HHEADU )
               ELSE IF ( LAY .EQ. 3 ) THEN
                  CALL GGLAY3  ( HHEADU )
               ELSE
                  CALL GGLAY1  ( HHEADU )
               ENDIF
*
*"  < 5. ベクトル >
*
               CALL GGAXES  ( HHEADU )
*
               CALL GGPSET ( 'VXINT',  INTV(1) )
               CALL GGPSET ( 'VYINT',  INTV(2) )
               CALL GGPSET ( 'VECFCT', FACT )
               CALL GGPSET ( 'LEQRAT', EQRAT )
               CALL GGPSET ( 'LUNIT',  LUNIT )
               CALL SGSLNI ( IDX )
*
               CALL GGVECT
     I               ( HHEADU, GDATAU,
     I                 HHEADV, GDATAV )
*
*"  < 6. 地図, 緯度経度線 > 
*
               IF ( MAP .GE.1  ) THEN
                  CALL GGMAPS( MFILE )
               ENDIF
*
            ENDIF
            IF ( II .LT. END ) GOTO 1100
         ENDIF
*
      CALL GFCLSE ( IFILE )
*
      CALL GGCLSE
*
      STOP
      END
