* PACKAGE GTSTRM   !" 質量流線関数
*********************************************************************
      PROGRAM GTSTRM
*
#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  HAITM  *(NCC)
*
      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. /
      CHARACTER  ITEM   *(NCC)
      CHARACTER  UNIT   *(NCC)
      CHARACTER  TITLE  *(NCC*2)
      CHARACTER  DSET   *(NCC)
      CHARACTER  EDIT   *(NCC)
      CHARACTER  ETTL   *(NCC)
      DATA       ITEM   / 'MSTRM' /
      DATA       UNIT   / 'kg/s' /
      DATA       TITLE  / 'mass stream function' /
      DATA       DSET, EDIT, ETTL /3*' '/
      LOGICAL    GRESET
      DATA       GRESET / .FALSE. /
      LOGICAL    HELP
      DATA       HELP   / .FALSE. /
*
      EXTERNAL   VACUM2
*     
      NAMELIST  /OPTION/ PS, OUT, APND,
     &                   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
*
      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 GHCGET ( HHEAD, 'AITM3', HAITM )
            CALL GMZEXT
     I         ( HHEADP, GDATAP,
     I           HAITM , 0     , 0     ,
     I           'NUL' , ' '             )
            CALL GMFFCT
     I         ( HHEADP, GDATAP, 100./9.8,
     I           'NUL' , ' '             )
            CALL GMFMLT
     I         ( HHEAD , GDATA ,
     I           HHEADP, GDATAP,
     I           'NUL' , ' '     )
            CALL GMXAVG
     I         ( HHEAD , GDATA , 
     I           '   ', ' '      )
*
            CALL GMCAL1
     I         ( VACUM2,
     M           HHEAD , GDATA ,
     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 VACUM2
     I         ( HHEAD , GDATA ,
     O           HHEADO, ACCUM ,
     D           JDIM  , KDIM  , KDIMX  )
*
      CHARACTER  HHEAD  ( * )*(*)
      REAL       GDATA  ( JDIM, KDIM )
      CHARACTER  HHEADO ( * )*(*)
      REAL       ACCUM  ( JDIM, KDIM )
*
      PARAMETER  ( NCC=16, NDC=64 )
      CHARACTER  HHEADA ( NDC )*(NCC)
      PARAMETER  ( KMAXD = 50 )
      REAL       DSIG ( KMAXD )
      PARAMETER  ( JMAXD = 200 )
      REAL       ALAT ( JMAXD )
      LOGICAL    OSUBCK
      DATA       ER / 6370.E3 /
*
      IF ( KDIMX .NE. 1 ) THEN
         CALL MSGDMP( 'E', 'VACUM2', 'THIS ROUTINE ASSUME Y-Z 2-DIM' )
      ENDIF
*
      CALL       GTPGET( 'SUBCHK', OSUBCK )
      CALL       GTSIZE( HHEADA, KMAXD )
      CALL       GUQAXV
     I         ( HHEAD , 2     , 'WGT' ,
     O           HHEADA, DSIG  , IEOD  )
      CALL       GTSIZE( HHEADA, JMAXD )
      CALL       GUQAXV
     I         ( HHEAD , 1     , 'LOC' ,
     O           HHEADA, ALAT  , IEOD  )
      CALL       GTPSET( 'SUBCHK', OSUBCK )
*
      CALL GHPGET( HHEAD, 'ASTR2', KSTR )
      IF ( KSTR .NE. 1 ) THEN
         CALL MSGDMP( 'E', 'VACUM2', 'KSTR MUST BE 1' )
      ENDIF
*
      CALL GUCACF
     I           ( HHEAD, 2     , 'M'   ,
     M             HHEADO                )
*
      CALL GHPSET( HHEADO, 'AEND2', KDIM+1 )
      CALL GUSZCK( HHEADO, JDIM*(KDIM+1)   )
*
      DO 3100 J = 1, JDIM
         ACCUM( J,1 ) = 0.
 3100 CONTINUE
*
      PI = ATAN( 1. ) * 4.
      DO 3200 K = 1, KDIM
         DO 3210 J = 1, JDIM
            ACCUM( J,K+1 ) = ACCUM( J,K )
     &                     + GDATA( J,K ) * DSIG( K )
     &                                    * COS( ALAT( J ) * PI/180. )
     &                                    * 2. * PI * ER
 3210    CONTINUE
 3200 CONTINUE
*
      RETURN
      END