* PACKAGE  GTTHET  !" ²¹°Ì<->²¹ÅÙ
***********************************************************************
      PROGRAM GTTHET
*
#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 )
      CHARACTER  HHEADP( NDC )*(NCC)
      REAL       GDATAP( IJKDIM )
*
      CHARACTER  HFILE( 1 ) *(NFILN)
      DATA       HFILE   / '$GTTMPDIR/gtool.out' /
      DATA       IFILE / 50 /
      DATA       IFILEP / 51 /
      DATA       JFILE / 60 /
*
      CHARACTER  PS     *(NFILN)
      DATA       PS     / 'Ps' /
      CHARACTER  OUT    *(NFILN)
      DATA       OUT    / '$GTTMPDIR/gtool.out' /
      LOGICAL    APND
      DATA       APND   / .FALSE. /
      LOGICAL    INV    
      DATA       INV   / .FALSE. /
      CHARACTER  ITEM   *(NCC)
      CHARACTER  UNIT   *(NCC)
      CHARACTER  TITLE  *(NCC*2)
      CHARACTER  DSET   *(NCC)
      CHARACTER  EDIT   *(NCC)
      CHARACTER  ETTL   *(NCC)
      DATA       ITEM   / 'THETA' /
      DATA       UNIT   / 'K' /
      DATA       TITLE  / 'potentital temp.' /
      DATA       DSET, EDIT, ETTL /3*' '/
      LOGICAL    GRESET
      DATA       GRESET / .FALSE. /
      LOGICAL    HELP
      DATA       HELP   / .FALSE. /
*
      EXTERNAL   T2THET
*     
      NAMELIST  /OPTION/ PS, OUT, APND, INV ,
     &                   ITEM, UNIT, TITLE, DSET, EDIT, ETTL, GRESET,
     &                   HELP, HFILE
*
      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
*
      IF ( INV ) THEN
         IF ( ITEM  .EQ. 'THETA'            ) ITEM = 'T'
         IF ( TITLE .EQ. 'potentital temp.' ) TITLE = 'temprerature'
         CALL STH2T
      ENDIF
*
      CALL GTOPEN
      CALL GTSIZE ( HHEAD, IJKDIM )
      CALL GTSIZE ( HHEADP, IJKDIM )
      CALL GMSIZE ( IJKDIM  )
*
      CALL GURNTF ( HFILE( 1 ), OUT  , '$GTTMPDIR/gtool.in' )
      CALL GURNTF ( PS        , OUT  , '$GTTMPDIR/gtool.in' )
*
      CALL GFROPN ( IFILE , HFILE( 1 ) )
      CALL GFROPN ( IFILEP, PS    )
      CALL GFOOPN ( JFILE ,  OUT , APND )
*
      CALL GUNENV( OUT,'.',.FALSE. )
      IL=LENC(OUT)
      WRITE (6,*) 'output='//OUT(1:IL)
*
 1100 CONTINUE
         CALL   GFREAD
     O        ( HHEAD , GDATA , IEOD  ,
     I          IFILE , 1               )
         CALL   GFREAD
     O        ( HHEADP, GDATAP, IEODP ,
     I          IFILEP, 1               )
*
         IF ( MAX(IEOD,IEODP) .EQ.0 ) THEN
            CALL GMCAL2
     I         ( T2THET,
     M           HHEAD , GDATA ,
     I           HHEADP, GDATAP,
     I           EDIT  , ETTL  )
*
            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  GFWRIT
     I                 ( HHEAD , GDATA ,
     I                   JFILE , 1     , 0       )
*
      GOTO 1100
         ENDIF
*
      STOP
      END
********************************************************************
      SUBROUTINE T2THET
     I         ( HT    , T     ,
     I           HPS   , PS    ,
     O           HTH   , TH    ,
     D           IDIM  , JDIM  , KDIM ,
     D           IDIM2 , JDIM2 , KDIM2 )
*
      CHARACTER  HT ( * )*(*)
      REAL       T  ( IDIM, JDIM, KDIM )
      CHARACTER  HPS ( * )*(*)
      REAL       PS ( IDIM2, JDIM2 )
      CHARACTER  HTH ( * )*(*)
      REAL       TH ( IDIM, JDIM, KDIM )
*
#ifdef SYS_IBMS
      INCLUDE    (GZSIZE)
#else
#include         "gzsize.F"
#endif
      CHARACTER  HHEADA ( NDC )*(NCC)
      PARAMETER  ( KDIMD = 100 )
      REAL       SIG ( KDIMD )
*
      DATA       P00  / 1000. /
      DATA       RAIR / 287.04 /
      DATA       CP   / 1004.6 /
*
      LOGICAL    OINV
      DATA       OINV / .FALSE. /
*
      IF ( KDIM .GT. KDIMD ) THEN
         CALL MSGDMP( 'E','T2THET','WORK AREA TOO SMALL' )
      ENDIF
*
      AKAPPA = RAIR / CP
* 
      CALL GTSIZE ( HHEADA  ,  KDIMD   )
      CALL GUQAXV
     I         ( HT    , 3     , 'LOC',
     O           HHEADA, SIG   , IEOD  )
*
      IF ( .NOT.OINV ) THEN
         DO 1100 K = 1, KDIM
            DO 1100 J = 1, JDIM
               DO 1100 I = 1, IDIM
                  TH ( I,J,K ) = T ( I,J,K ) 
     &                         / ( PS( I,J )*SIG( K )/ P00 )** AKAPPA
 1100    CONTINUE
      ELSE
         DO 1200 K = 1, KDIM
            DO 1200 J = 1, JDIM
               DO 1200 I = 1, IDIM
                  T  ( I,J,K ) = TH ( I,J,K ) 
     &                         * ( PS( I,J )*SIG( K )/ P00 )** AKAPPA
 1200    CONTINUE
      ENDIF
*
      RETURN
*=================================================================
      ENTRY STH2T
*
      OINV = .TRUE.
*
      RETURN
      END

