* PACKAGE GTCNVT !" $@%Y%/%H%k(J, $@EyCM@~?^(J($@B.EY(J, $@29EY>l(J) 
*"                  gamiras model $@%j%9%?!<%H%U%!%$%k=PNOI=<(@lMQ(J
*" 95/05/31 (takepiro) for dcl-5.0
******************************************************************
      PROGRAM GTCNVT
*
#ifdef SYS_IBMS
      INCLUDE    (GTSINC)
      INCLUDE    (GZSIZE)
#else
#include         "gtsinc.F"
#include         "gzsize.F"
#endif
      COMMON     /GMWORK/ MWORK
      REAL       MWORK  ( IJKDIM )
*
      REAL       GDU( IJKDIM )
      REAL       GDV( IJKDIM )
      REAL       GDW( IJKDIM )
      REAL       GDT( IJKDIM )
      REAL       GDTOR( IJKDIM )
      REAL       GDPOR( IJKDIM )
*
      CHARACTER  HHEADU( NDC )*(NCC)
      CHARACTER  HHEADV( NDC )*(NCC)
      CHARACTER  HHEADW( NDC )*(NCC)
      CHARACTER  HHEADT( NDC )*(NCC)
      CHARACTER  HHEDTR( NDC )*(NCC)
      CHARACTER  HHEDPR( NDC )*(NCC)
*
      INTEGER    NTMX
      PARAMETER  ( NTMX=20 )
      DATA       IFILE  / 50 /
      CHARACTER  HFILE( 1 )  *(NFILN)
      DATA       HFILE / '$GTTMPDIR/gtool.out' /
*
      REAL      XMIN, XMAX, YMIN, YMAX            !" $@IA2h0LCV(J
        DATA   XMIN, XMAX  / 0.2,  0.8 /
        DATA   YMIN, YMAX  / 0.10, 0.55 /
*
*" [$@%*%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(2), Y(2), Z(2)          !" $@I=<($9$k%Y%/%H%k>l$N:BI8(J(1)
        DATA       X, Y, Z / 6*-1 /        !" $@I=<($9$kB.EY29EY>l$N:BI8(J(2)
      REAL       CONT  ( 4 )
        DATA       CONT  / 4 * -999. /
      INTEGER    CCYCLE
        DATA       CCYCLE / 5 /
      INTEGER    CIDX ( 2 )
        DATA       CIDX  / 1, 3 /
      INTEGER    INTV ( 2 )             !" $@Lp0u%W%m%C%H4V3V(J
        DATA       INTV / 2*1 /
      REAL       FACT                   !" $@%Y%/%H%k$N%9%1!<%j%s%0%U%!%/%?!<(J
        DATA       FACT    / 1.0 /
      LOGICAL    EQRAT                  !" X, Y $@J}8~%9%1!<%j%s%0$rF1$8$K$9$k(J
        DATA       EQRAT   / .TRUE. /   
      LOGICAL    LUNIT                  !" $@%f%K%C%H%Y%/%H%k$rIA$/$+(J
        DATA       LUNIT   / .TRUE. / 
      INTEGER    IARLEN                 !" $@%Y%/%H%kEj1F%b!<%I(J
        DATA       IARLEN  / 3 / 
      INTEGER    ICENT                  !" $@%Y%/%H%kEj1FCf?4(J
        DATA       ICENT   / -1 / 
      INTEGER    MAP , MAPIDX
        DATA       MAP , MAPIDX / 0, 1 /
      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 ( 4 )
        DATA       RANGE / 4*-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/  PRJ, POSI, ROTA, MAG, 
     &                   X, Y, Z,
     &                   INTV, FACT, LUNIT, EQRAT, IARLEN, ICENT,
     &                   MAP, MAPIDX, LAY, WSN, MONO, PRINT, PS,
     &                   RANGE, STR, END, STEP, EXCH,
     &                   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 ( HHEADU, IJKDIM )
      CALL GTSIZE ( HHEADV, IJKDIM )
      CALL GTSIZE ( HHEADW, IJKDIM )
      CALL GTSIZE ( HHEADT, IJKDIM )
      CALL GTSIZE ( HHEDTR, IJKDIM )
      CALL GTSIZE ( HHEDPR, 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
*
*" $@IA2h0LCV@_Dj(J
*
      CALL GGOPEN ( WSN )
*
      CALL GGPSET( 'MAPPRJ', PRJ  )             !" $@Ej1FK!(J
      CALL GGPSET( 'MAPLAT', POSI(1) )          !" $@Ej1FCf?40^EY(J
      CALL GGPSET( 'MAPLON', POSI(2) )          !" $@Ej1FCf?47PEY(J
      CALL GGPSET( 'MAPROT', ROTA )             !" $@Ej1F2sE>(J
      CALL GGPSET( 'MAPFAC', MAG )              !" $@Ej1F3HBgN((J
*     
      CALL GGMSET( 'IARLEN', IARLEN )        !" $@%Y%/%H%kI=<(%b!<%I(J
      CALL GGMSET( 'ICENT' , ICENT  )        !" $@%Y%/%H%kI=<(0LCV(J
*
      CALL GGPSET ( 'VXINT',  INTV(1) )      !" $@%Y%/%H%kI=<(4V3V(J
      CALL GGPSET ( 'VYINT',  INTV(2) )      !" $@%Y%/%H%kI=<(4V3V(J
      CALL GGPSET ( 'VECFCT', FACT )         !" $@%Y%/%H%kI=<(3HBgN((J
      CALL GGPSET ( 'LEQRAT', EQRAT )
      CALL GGPSET ( 'LUNIT',  LUNIT )        !" $@C10L%Y%/%H%kI=<(%9%$%C%A(J
      CALL SGSLAI ( IDX )
*     
      CALL GGPSET( 'VXMIN' , XMIN )
      CALL GGPSET( 'VXMAX' , XMAX )
      CALL GGPSET( 'VYMIN' , YMIN )
      CALL GGPSET( 'VYMAX' , YMAX )
*
      CALL GGPSET( 'TXSLOC', TXLOC )
      CALL GGPSET( 'TYSLOC', TYLOC )
      CALL GGPSET( 'TXSWDH', TXWDH )
      CALL GGPSET( 'TYSWDH', TYWDH )
*
      CALL GFROPN ( IFILE, HFILE )
*
      IF ( X(1).LT.0 .AND. Y(1).LT.0 .AND. Z(1).LT.0 ) Z(1) = 0
      IF ( X(1).GE.0 .AND. X(2).LT.0 ) X(2) = X(1)
      IF ( Y(1).GE.0 .AND. Y(2).LT.0 ) Y(2) = Y(1)
      IF ( Z(1).GE.0 .AND. Z(2).LT.0 ) Z(2) = Z(1)
      IF ( STEP .LE. 1 ) STEP = 1
* 
*"  << 2. $@%G!<%?FI$_9~$_(J >> 
*
      II = 0
 1100 CONTINUE
*
         CALL GFBRED
     O            ( HHEADU , GDU, IEODU ,
     I              IFILE  , 1               )
         CALL GFBRED
     O            ( HHEADV, GDV, IEODV ,
     I              IFILE , 1               )
         CALL GFBRED
     O            ( HHEADW, GDW, IEODW ,
     I              IFILE , 1               )
         CALL GFBRED
     O            ( HHEADT, GDT, IEODT ,
     I              IFILE , 1               )
         CALL GFBRED
     O            ( HHEDTR, GDTOR, IEODTR ,
     I              IFILE , 1               )
         CALL GFBRED
     O            ( HHEDPR, GDPOR, IEODPR ,
     I              IFILE , 1               )
*
         IF ( MAX(IEODU,IEODV,IEODW,IEODT,IEODTR,IEODPR) .EQ. 0 ) THEN
*
            II = II + 1
            IF ( ( II.GE.STR ).AND.( II.LE.END ).AND.
     &           ( MOD( II-STR,STEP ).EQ.0 )          ) THEN         

*
*"  << 3. $@%G!<%?2C9)(J >>
*
*"     < 3.1 $@3J;RE@A*Br(J, $@J?6QA`:n(J >
*
               IF      ( X(1) .EQ. 0 ) THEN
                  CALL GMXAVG
     I            ( HHEADV, GDV,
     I              'XM'  , 'zonal mean'  )
                  CALL GMXAVG
     I            ( HHEADW, GDW,
     I              'XM'  , 'zonal mean'  )
               ENDIF
               IF      ( X(2) .EQ. 0 ) THEN
                  CALL GMXAVG
     I            ( HHEADU, GDU,
     I              'XM'  , 'zonal mean'  )
                  CALL GMXAVG
     I            ( HHEADT, GDT,
     I              'XM'  , 'zonal mean'  )
               ENDIF
               IF ( X(1) .GT. 0 ) THEN
                  CALL GMXSEL
     I            ( HHEADV, GDV, X(1)   ,
     I              '  '  , ' '           )
                  CALL GMXSEL
     I            ( HHEADW, GDW, X(1)   ,
     I              '  '  , ' '           )
               ENDIF
               IF ( X(2) .GT. 0 ) THEN
                  CALL GMXSEL
     I            ( HHEADU, GDU, X(2)   ,
     I              '  '  , ' '           )
                  CALL GMXSEL
     I            ( HHEADT, GDT, X(2)   ,
     I              '  '  , ' '           )
               ENDIF
*
               IF ( Y(1) .EQ. 0 ) THEN
                  CALL GMYAVG
     I            ( HHEADU, GDU,
     I              'YM'  , 'merid mean'  )
                  CALL GMYAVG
     I            ( HHEADW, GDW,
     I              'YM'  , 'merid mean'  )
               ENDIF
               IF ( Y(2) .EQ. 0 ) THEN
                  CALL GMYAVG
     I            ( HHEADV, GDV,
     I              'YM'  , 'merid mean'  )
                  CALL GMYAVG
     I            ( HHEADT, GDT,
     I              'YM'  , 'merid mean'  )
               ENDIF
               IF ( Y(1) .GT. 0 ) THEN
                  CALL GMYSEL
     I            ( HHEADU, GDU, Y(1)   ,
     I              '  '  , '  '          )
                  CALL GMYSEL
     I            ( HHEADW, GDW, Y(1)   ,
     I              '  '  , '  '          )
               ENDIF
               IF ( Y(2) .GT. 0 ) THEN
                  CALL GMYSEL
     I            ( HHEADV, GDV, Y(2)   ,
     I              '  '  , '  '          )
                  CALL GMYSEL
     I            ( HHEADT, GDT, Y(2)   ,
     I              '  '  , '  '          )
               ENDIF
               IF ( Z(1) .EQ. 0 ) THEN
                  CALL GMZAVG
     I            ( HHEADU, GDU,
     I              'ZM'  , 'vert mean'   )
                  CALL GMZAVG
     I            ( HHEADV, GDV,
     I              'ZM'  , 'vert mean'   )
               ENDIF
               IF ( Z(2) .EQ. 0 ) THEN
                  CALL GMZAVG
     I            ( HHEADW, GDW,
     I              'ZM'  , 'vert mean'   )
                  CALL GMZAVG
     I            ( HHEADT, GDT,
     I              'ZM'  , 'vert mean'   )
               ENDIF
               IF ( Z(1) .GT. 0 ) THEN
                  CALL GMZSEL
     I            ( HHEADU, GDU, Z(1)  ,
     I              ' '   , ' '           )
                  CALL GMZSEL
     I            ( HHEADV, GDV, Z(1)  ,
     I              ' '   , ' '           )
               ENDIF
               IF ( Z(2) .GT. 0 ) THEN
                  CALL GMZSEL
     I            ( HHEADW, GDW, Z(2)  ,
     I              ' '   , ' '           )
                  CALL GMZSEL
     I            ( HHEADT, GDT, Z(2)  ,
     I              ' '   , ' '           )
               ENDIF
*
               CALL GMXCYC
     I            ( HHEADU, GDU )
               CALL GMXCYC
     I            ( HHEADV, GDV )
               CALL GMXCYC
     I            ( HHEADW, GDW )
               CALL GMXCYC
     I            ( HHEADT, GDT )
*
               IF ( EXCH ) THEN
                  CALL GMEYXZ
     I            ( HHEADU, GDU,
     I              '  ' , '  '  )
                  CALL GMEYXZ
     I            ( HHEADV, GDV,
     I              '  ' , '  '  )
                  CALL GMEYXZ
     I            ( HHEADW, GDW,
     I              '  ' , '  '  )
                  CALL GMEYXZ
     I            ( HHEADT, GDT,
     I              '  ' , '  '  )
               ENDIF
*
*"    < 3.2 $@I=<(NL%?%$%H%k(J, $@C10L@_Dj(J >
*
               IF ( ITEM .NE. ' ' ) THEN
                  CALL GHCSET( HHEADU, 'ITEM', ITEM )
                  CALL GHCSET( HHEADV, 'ITEM', ITEM )
                  CALL GHCSET( HHEADW, 'ITEM', ITEM )
                  CALL GHCSET( HHEADT, 'ITEM', ITEM )
               ENDIF
*
               IF ( UNIT .NE. ' ' ) THEN
                  CALL GHCSET( HHEADU, 'UNIT', UNIT )
                  CALL GHCSET( HHEADV, 'UNIT', UNIT )
                  CALL GHCSET( HHEADW, 'UNIT', UNIT )
                  CALL GHCSET( HHEADT, 'UNIT', UNIT )
               ENDIF
*
               IF ( TITLE .NE. ' ' ) THEN
                  CALL GHCSTS( HHEADU, 'TITL', TITLE )
                  CALL GHCSTS( HHEADV, 'TITL', TITLE )
                  CALL GHCSTS( HHEADW, 'TITL', TITLE )
                  CALL GHCSTS( HHEADT, 'TITL', TITLE )
               ENDIF
*
               IF ( DSET .NE. ' ' ) THEN
                  CALL GHCSET( HHEADU, 'DSET', DSET )
                  CALL GHCSET( HHEADV, 'DSET', DSET )
                  CALL GHCSET( HHEADW, 'DSET', DSET )
                  CALL GHCSET( HHEADT, 'DSET', DSET )
               ENDIF
*
               IF ( GRESET ) THEN
                  CALL GHRSGP( HHEADV  )
                  CALL GHRSGP( HHEADV  )
               ENDIF
*
*"     < 3.3 $@%3%s%?!<4V3V(J >
*
               IF ( CONT(1) .GT. 0. ) THEN
                  IF( X(1) .GE. 0.0 )THEN
                     CALL GHPSET( HHEADU, 'DIVS', CONT(1) )
                  ELSE IF( Y(1) .GE. 0.0 )THEN
                     CALL GHPSET( HHEADV, 'DIVS', CONT(1) )
                  ELSE IF( Z(1) .GE. 0.0 )THEN
                     CALL GHPSET( HHEADW, 'DIVS', CONT(1) )
                  ENDIF
               ENDIF
               IF ( CONT(2) .GT. 0. ) THEN
                  IF( X(1) .GE. 0.0 )THEN
                     CALL GHPSET( HHEADU, 'DIVL', CONT(2) )
                  ELSE IF( Y(1) .GE. 0.0 )THEN
                     CALL GHPSET( HHEADV, 'DIVL', CONT(2) )
                  ELSE IF( Z(1) .GE. 0.0 )THEN
                     CALL GHPSET( HHEADW, 'DIVL', CONT(2) )
                  ENDIF
               ENDIF
               IF ( CONT(3) .GT. 0. ) THEN
                  CALL GHPSET( HHEADT, 'DIVS', CONT(3) )
               ENDIF
               IF ( CONT(4) .GT. 0. ) THEN
                  CALL GHPSET( HHEADT, 'DIVL', CONT(4) )
               ENDIF
*
*"     < 3.4 $@I=<(HO0O(J >
*
               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
               IF ( RANGE(3) .NE. -999. ) THEN
                  CALL GHPSET( HHEADW, 'DMIN', 0.       )
                  CALL GHPSET( HHEADW, 'DMAX', RANGE(3) )
               ENDIF
               IF ( RANGE(4) .NE. -999. ) THEN
                  CALL GHPSET( HHEADT, 'DMIN', 0.       )
                  CALL GHPSET( HHEADT, 'DMAX', RANGE(4) )
               ENDIF
*
*"  << 4. $@<4$N@_Dj(J >>
*
               CALL UZINIT
               CALL UDPSET  ( 'LABEL',  CLABEL )
               CALL UDPSET  ( 'INDXMJ', CIDX(2) )
               CALL UDPSET  ( 'INDXMN', CIDX(1) )
*
               IF ( X(1). GE. 0 ) THEN        !" $@;R8aLLI=<((J
                  CALL GGLAY   ( LAY, HHEADU )
                  CALL GGAXES  ( HHEADU )
                  CALL GGCNVT 
     I                   ( HHEADW , GDW , 
     I                     HHEADV , GDV , 
     I                     HHEADU , GDU  )
*
                  CALL GGLAY   ( LAY, HHEADT )
                  CALL GGAXES  ( HHEADT )
                  CALL GGCNVT 
     I                   ( HHEADW , GDW , 
     I                     HHEADV , GDV , 
     I                     HHEADU , GDT  )

               ELSE IF ( Y(1). GE. 0 ) THEN        !" 
                  CALL GGLAY   ( LAY, HHEADV )
                  CALL GGAXES  ( HHEADV )
                  CALL GGCNVT 
     I                   ( HHEADW , GDW , 
     I                     HHEADU , GDU , 
     I                     HHEADV , GDV  )
*
                  CALL GGLAY   ( LAY, HHEADT )
                  CALL GGAXES  ( HHEADT )
                  CALL GGCNVT 
     I                   ( HHEADW , GDW , 
     I                     HHEADU , GDU , 
     I                     HHEADU , GDT  )
               ELSE IF ( Z(1). GE. 0 ) THEN        !" $@CO?^Ej1F(J
                  CALL GGLAY   ( LAY, HHEADW )
                  CALL GGAXES  ( HHEADW )
                  CALL GGCNVT 
     I                   ( HHEADU , GDU , 
     I                     HHEADV , GDV , 
     I                     HHEADW , GDW  )
*
                  CALL GGLAY   ( LAY, HHEADT )
                  CALL GGAXES  ( HHEADT )
                  CALL GGCNVT 
     I                   ( HHEADU , GDU , 
     I                     HHEADV , GDV , 
     I                     HHEADU , GDT  )
               ENDIF
*
            ENDIF
            IF ( II .LT. END ) GOTO 1100
         ENDIF
*
      CALL GFCLSE ( IFILE )
*
      CALL GGCLSE
*
      STOP
      END
**********************************************************************
      SUBROUTINE GGLAY
     I             ( LAY, HHEAD )
*
#ifdef SYS_IBMS
      INCLUDE    (GTSINC)
      INCLUDE    (GZSIZE)
#else
#include         "gtsinc.F"
#include         "gzsize.F"
#endif
*
      CHARACTER  HHEAD( NDC )*(NCC)
      INTEGER LAY
*
      IF      ( LAY .EQ. 2 ) THEN
         CALL GGLAY2  ( HHEAD )
      ELSE IF ( LAY .EQ. 3 ) THEN
         CALL GGLAY3  ( HHEAD )
      ELSE
         CALL GGLAY1  ( HHEAD )
      ENDIF
      RETURN
      END
**********************************************************************
      SUBROUTINE GGCNVT 
     I            ( HHEADU , GVECTU , 
     I              HHEADV , GVECTV , 
     I              HHEAD  , GDATA    )
*
#ifdef SYS_IBMS
      INCLUDE    (GTSINC)
      INCLUDE    (GZSIZE)
#else
#include         "gtsinc.F"
#include         "gzsize.F"
#endif
*
      REAL       GVECTU( IJKDIM )
      REAL       GVECTV( IJKDIM )
      REAL       GDATA ( IJKDIM )
*
      CHARACTER  HHEADU( NDC )*(NCC)
      CHARACTER  HHEADV( NDC )*(NCC)
      CHARACTER  HHEAD ( NDC )*(NCC)
*
      CALL GGMVCT
     I       ( HHEADU, GVECTU,
     I         HHEADU, GVECTV )
*
      CALL SGLSET('LCLIP',.TRUE.)
      CALL GGCNTR  ( HHEAD , GDATA )
      CALL SGLSET('LCLIP',.FALSE.)
*
      RETURN
      END
