*%表題   GTOOL 形式格子情報ファイルの作成
*%
*%履歴   91/05/21 佐藤正樹       C:\FORT\OORT\SWAXIS.FOR
*%
*%
      PROGRAM SWAXIS
*
      PARAMETER ( IMAX  = 1,  JMAX = 37,   KMAX  = 21 )
      PARAMETER  (NDC=64,NCC=16)
*
      CHARACTER  HHLON ( NDC )*(NCC)
      REAL       ALON  ( IMAX+1 )
      CHARACTER  HHDLON( NDC )*(NCC)
      REAL       DLON  ( IMAX+1 )
      CHARACTER  HHLAT ( NDC )*(NCC)
      REAL       ALAT  ( JMAX )
      CHARACTER  HHDLAT( NDC )*(NCC)
      REAL       DLAT  ( JMAX )
      CHARACTER  HHPRS ( NDC )*(NCC)
      REAL       PRS   ( KMAX )
      CHARACTER  HHDPRS( NDC )*(NCC)
      REAL       DPRS  ( KMAX )
      CHARACTER  HHPRSM( NDC )*(NCC)
      REAL       PRSM  ( KMAX+1 )
      CHARACTER  HHDPRM( NDC )*(NCC)
      REAL       DPRSM ( KMAX+1 )
*
      CHARACTER  HALON        *(NCC)
      CHARACTER  HALAT        *(NCC)
      CHARACTER  HAPRS        *(NCC)
      CHARACTER  HAPRSM       *(NCC)
      CHARACTER  HALOC        *(NCC)
      CHARACTER  HAWGT        *(NCC)
*
      CHARACTER  HFLON * 30
      CHARACTER  HFDLON* 30
      CHARACTER  HFLAT * 30
      CHARACTER  HFDLAT* 30
      CHARACTER  HFPRS * 30
      CHARACTER  HFDPRS* 30
      CHARACTER  HFPRSM* 30
      CHARACTER  HFDSGM* 30
*
      DATA       JFILE / 50 /
*
      CALL GTSIZE ( HHLON , IMAX+1 )
      CALL GTSIZE ( HHDLON, IMAX+1 )
      CALL GTSIZE ( HHLAT , JMAX   )
      CALL GTSIZE ( HHDLAT, JMAX   )
      CALL GTSIZE ( HHPRS , KMAX   )
      CALL GTSIZE ( HHDPRS, KMAX   )
      CALL GTSIZE ( HHPRSM, KMAX+1 )
      CALL GTSIZE ( HHDPRM, KMAX+1 )
      CALL GTSIGN ( 'SATOH' )
*
*          < 1. 格子点設定 >
*
      CALL SETLON
     I         ( ALON  , DLON  , HALON  ,
     D           IMAX                    )
*
      CALL SETLAT
     I         ( ALAT  , DLAT  , HALAT  ,
     D           JMAX                    )
*
      CALL SETHGT
     I         ( PRS   , DPRS  , HAPRS  ,
     I           PRSM  , DPRSM , HAPRSM ,
     D           KMAX                    )
*
*          < 2. ファイル名 >
*
      HALOC  = 'G'
      HAWGT  = 'D'

      HFLON  = HALOC(1:1)//HALON
      HFDLON = HAWGT(1:1)//HALON
      HFLAT  = HALOC(1:1)//HALAT
      HFDLAT = HAWGT(1:1)//HALAT
      HFPRS  = HALOC(1:1)//HAPRS
      HFDPRS = HAWGT(1:1)//HAPRS
      HFPRSM = HALOC(1:1)//HAPRSM
      HFDSGM = HAWGT(1:1)//HAPRSM
*
*          < 3. ヘッダー設定 >
*
      CALL GHPACA
     O         ( HHLON ,
     I           'AXLOC', HALON ,
     I           'longitude'   , 'deg' , IMAX ,
     I           '(5E16.6)' , -9999.,
     I              0. ,  0. ,  0.  , 0.   , 1     )
*
      CALL GHCOPY ( HHLON , HHDLON )
      CALL GHCSET ( HHDLON, 'DSET', 'AXWGT' )
*
      CALL GHPACA
     O         ( HHLAT ,
     I           'AXLOC', HALAT ,
     I           'latitude'    , 'deg' , JMAX ,
     I           '(5E16.6)' , -9999.,
     I            -90. ,   90. ,  10.  , 30.   , 1     )
*
      CALL GHCOPY ( HHLAT , HHDLAT )
      CALL GHCSET ( HHDLAT, 'DSET', 'AXWGT' )
*
      CALL GHPACA
     O         ( HHPRS ,
     I           'AXLOC', HAPRS ,
     I           'pressure'       , 'Pa'   , KMAX ,
     I           '(5E16.6)' , -9999.,
     I              0. ,    100000. ,  5000.,  20000., -1    )
*
      CALL GHCOPY ( HHPRS , HHDPRS )
      CALL GHCSET ( HHDPRS, 'DSET', 'AXWGT' )
*
      CALL GHPACA
     O         ( HHPRSM,
     I           'AXLOC', HAPRSM,
     I           'PRSma'       , ' '   , KMAX+1,
     I           '(5E16.6)' , -9999.,
     I              0. ,    100000. ,  5000.,  20000., -1    )
*
      CALL GHCOPY ( HHPRSM, HHDPRM )
      CALL GHCSET ( HHDPRM, 'DSET', 'AXWGT' )
*
*          < 4. ファイル書き込み >
*
      CALL GFWOP2( JFILE, HFLON  )
      CALL GFWRI2
     I        ( HHLON , ALON  ,
     I          JFILE , 1     , 0     )
      CALL GFCLSE( JFILE )
*
      CALL GFWOP2( JFILE, HFDLON )
      CALL GFWRI2
     I        ( HHDLON, DLON  ,
     I          JFILE , 1     , 0     )
      CALL GFCLSE( JFILE )
*
      CALL GFWOP2( JFILE, HFLAT  )
      CALL GFWRI2
     I        ( HHLAT , ALAT  ,
     I          JFILE , 1     , 0     )
      CALL GFCLSE( JFILE )
*
      CALL GFWOP2( JFILE, HFDLAT )
      CALL GFWRI2
     I        ( HHDLAT, DLAT  ,
     I          JFILE , 1     , 0     )
      CALL GFCLSE( JFILE )
*
      CALL GFWOP2( JFILE, HFPRS  )
      CALL GFWRI2
     I        ( HHPRS , PRS   ,
     I          JFILE , 1     , 0     )
      CALL GFCLSE( JFILE )
*
      CALL GFWOP2( JFILE, HFDPRS )
      CALL GFWRI2
     I        ( HHDPRS, DPRS  ,
     I          JFILE , 1     , 0     )
      CALL GFCLSE( JFILE )
*
      CALL GFWOP2( JFILE, HFPRSM )
      CALL GFWRI2
     I        ( HHPRSM, PRSM  ,
     I          JFILE , 1     , 0     )
      CALL GFCLSE( JFILE )
*
      CALL GFWOP2( JFILE, HFDSGM )
      CALL GFWRI2
     I        ( HHDPRM, DPRSM ,
     I          JFILE , 1     , 0     )
      CALL GFCLSE( JFILE )
*
      STOP
      END
**********************************************************************
      SUBROUTINE SETLON
     I         ( ALON  , DLON  , HALON  ,
     D           IMAX                    )
*
      REAL       ALON  ( IMAX+1 )
      REAL       DLON  ( IMAX+1 )
      CHARACTER  HALON         *(*)
*
      HALON = 'LON1'
*
      DO 3100 I = 1, IMAX
         ALON( I ) = 0.
 3100 CONTINUE
*
      DO 3200 I = 1, IMAX
         DLON ( I ) = 360./REAL(IMAX)
 3200 CONTINUE
*
      RETURN
      END
**********************************************************************
      SUBROUTINE SETLAT
     I         ( ALAT  , DLAT  , HALAT  ,
     D           JMAX                    )
*
      REAL       ALAT  ( JMAX )
      REAL       DLAT  ( JMAX )
      CHARACTER  HALAT         *(*)
*
      HALAT = 'LAT37'
*
      NLAT = INT( ( JMAX - 1 ) / 2. )
      DO 4100 J = 1, JMAX
        ALAT(J) = REAL(J-NLAT-1) / REAL(NLAT) * 90.
 4100  CONTINUE
*
      PI = ATAN( 1. )*4.
      DO 4200 J = 1, JMAX
         DLAT ( J ) = SIN( ALAT(J) * PI / 180. )
 4200 CONTINUE
*
      RETURN
      END
**********************************************************************
      SUBROUTINE SETHGT
     I         ( PRS   , DPRS  , HAPRS  ,
     I           PRSM  , DPRSM , HAPRSM ,
     D           KMAX                    )
*
      REAL       PRS   ( KMAX )
      REAL       PRSM  ( KMAX+1 )
      REAL       DPRS  ( KMAX )
      REAL       DPRSM ( KMAX+1 )
      CHARACTER  HAPRS         *(*)
      CHARACTER  HAPRSM        *(*)
*
      REAL       PRSS / 1.E5 /         ! 地表面気圧
      REAL       PRST / 0. /           ! 上端気圧
*
      HAPRS = 'PRS21'
      HAPRSM = 'PRSM21'
*
      DO 1000 K = 1, KMAX
        PRS(K) = REAL(K-1) / REAL(KMAX-1) * ( PRSS - PRST ) + PRST
 1000 CONTINUE
*
      DO 1100 K = 2, KMAX
        PRSM(K) = ( PRS(K-1) + PRS(K) ) / 2.
 1100 CONTINUE
      PRSM(1)      = PRS(1)
      PRSM(KMAX+1) = PRS(KMAX)
*
      DO 1200 K = 2, KMAX
        DPRSM( K ) = PRS( K ) - PRS( K-1 )
 1200 CONTINUE
      DPRSM( 1      ) = PRS( 1 ) - PRST
      DPRSM( KMAX+1 ) = PRSS - PRS( KMAX )
*
      DO 1300 K = 2, KMAX-1
        DPRS( K ) = PRSM( K+1 ) - PRSM( K )
 1300 CONTINUE
      DPRS( 1      ) = PRSM( 2 ) - PRST
      DPRS( KMAX   ) = PRSS - PRSM( KMAX )
*
      RETURN
      END
