* PACKAGE XMKAXIS   !" GTOOL3 軸ファイルの作成
*
*"  [HIS] 92/09/11(takepiro)
*"        93/04/30(takepiro)
*
*******************************************************************
      PROGRAM MKAXIS  !" GTOOL3 軸ファイルの作成
*
*   [PARAM] 
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数, 波数
      INCLUDE   (GZSIZE)
      INCLUDE   (ZCCOM)                      !" 標準物理定数
#else
#include        "zcdim.F"                    !" 格子点数, 波数
#include        "zccom.F"                    !" 標準物理定数
#include        "gzsize.F"
#endif
*
*   [VAR]
      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  HHRAD ( NDC )*(NCC)
      REAL       ARAD   ( 0:KDIM )
      CHARACTER  HHDRAD( NDC )*(NCC)
      REAL       DRAD  ( 0:KDIM )
*
      CHARACTER  HALON        *(NCC)
      CHARACTER  HALAT        *(NCC)
      CHARACTER  HARAD        *(NCC)
      CHARACTER  HALOC        *(NFILN)
      CHARACTER  HAWGT        *(NFILN)
*
      CHARACTER  HFLON  *(NFILN)
      CHARACTER  HFDLON *(NFILN)
      CHARACTER  HFLAT  *(NFILN)
      CHARACTER  HFDLAT *(NFILN)
      CHARACTER  HFRAD  *(NFILN)
      CHARACTER  HFDRAD *(NFILN)
*
*   [INTERNAL PARM] 
      INTEGER    JFILE
      DATA       JFILE / 50 /
      INTEGER    IT
      INTEGER    IDATE ( 6 )
      INTEGER    ISTEP
      INTEGER    ITDUR
      DATA       IT    / 0 /
      DATA       IDATE / 1990, 1, 1, 0, 0, 0 /
      DATA       ISTEP / 0 /
      DATA       ITDUR / 1 /
      CHARACTER  HDFMT *(NCC)
      DATA       HDFMT / 'UR4' /
*
*   [INTERNAL WORK] 
      INTEGER    NHL, NHW
      INTEGER    I, J
      REAL       PI, VMISS
*
*   [EXTERNAL FUNC] 
      INTEGER    LENC
*
      CALL PCONST
c$$$      DATA       ERI, ERO, ETA / 0.2, 1.0, 0.2/
c$$$      DATA       ERI, ERO, ETA / 0.4, 1.0, 0.4/
c$$$      DATA       ERI, ERO, ETA / 0.6, 1.0, 0.6/
c$$$      DATA       ERI, ERO, ETA / 0.8, 1.0, 0.8/
*
      CALL GTOPEN
      CALL GTSIZE ( HHLON , IMAX+1 )
      CALL GTSIZE ( HHDLON, IMAX+1 )
      CALL GTSIZE ( HHLAT , JMAX   )
      CALL GTSIZE ( HHDLAT, JMAX   )
      CALL GTSIZE ( HHRAD , KMAX   )
      CALL GTSIZE ( HHDRAD, KMAX   )
*
*"         < 1. 格子点設定 >
*
      CALL SETLON
     O         ( ALON  , DLON  , HALON ,
     D           IMAX  , IDIM            )
*
      PI = ATAN(1.) * 4.
      DO 1100 I = 1, IMAX
         ALON ( I ) = ALON( I )*180./PI
 1100 CONTINUE
      ALON ( IMAX+1 ) = 360.
      DLON ( IMAX+1 ) = DLON( 1 )
*
      CALL SETLAT
     O         ( ALAT  , DLAT  , HALAT ,
     D           JMAX  , JDIM            )
*
      DO 1200 J = 1, JMAX
         ALAT( J ) = ALAT( J )*180/PI
 1200 CONTINUE
*
      CALL SETRAD
     O         ( ARAD  , DRAD  , HARAD ,
     D           KDIM                    )
*
*"         < 2. ファイル名 >
*
      CALL GTCGET( 'FAXLOC1', HALOC )
***      CALL GTCGET( 'FAXLOC', HALOC )
      CALL GTCGET( 'FAXWGT1', HAWGT )
***      CALL GTCGET( 'FAXWGT', HAWGT )
*
      NHL = LENC( HALOC )
      NHW = LENC( HAWGT )
*
      HFLON  = HALOC(1:NHL)//HALON
      HFDLON = HAWGT(1:NHW)//HALON
      HFLAT  = HALOC(1:NHL)//HALAT
      HFDLAT = HAWGT(1:NHW)//HALAT
      HFRAD  = HALOC(1:NHL)//HARAD
      HFDRAD = HAWGT(1:NHW)//HARAD
*
*"         < 3. ヘッダー設定 >
*
      CALL GZDBGT( 'MISS' , VMISS )
*
      CALL GZDBAP
     O         ( HHLON ,
     I           'CAXLOC', HALON ,
     I           'longitude'   , 'deg' , IMAX ,
     I           'UR4' ,  VMISS,
     I              0. ,  360. ,  10.  , 30.   , 1     )
*
      CALL GHCOPY ( HHLON , HHDLON )
      CALL GHCSET ( HHDLON, 'DSET', 'CAXWGT' )
*
      CALL GZDBAP
     O         ( HHLAT ,
     I           'AXLOC', HALAT ,
     I           'latitude'    , 'deg' , JMAX ,
     I           'UR4' ,  VMISS,
     I            -90. ,   90. ,  10.  , 30.   , 1     )
*
      CALL GHCOPY ( HHLAT , HHDLAT )
      CALL GHCSET ( HHDLAT, 'DSET', 'AXWGT' )
*
      CALL GZDBAP
     O         ( HHRAD ,
     I           'AXLOC', HARAD ,
     I           'radius(non-dim)', ' '   , KMAX ,
     I           'UR4' ,  VMISS,
     I            ERI  ,  ERO  ,  0.1  ,  0.5  , 1    )
*
      CALL GHCOPY ( HHRAD , HHDRAD )
      CALL GHCSET ( HHDRAD, 'DSET', 'AXWGT' )
*
*"         < 4. ファイル書き込み >
*
      CALL GFWOPN( JFILE, HFLON  )
      CALL GZDBWX              !" 精度変換書き込み
     I         ( HHLON , ALON  ,
     I           IT    , IDATE , ISTEP , ITDUR ,
     I           JFILE , 1     , 0     , HDFMT   )
      CALL GFCLSE( JFILE )
*
      CALL GFWOPN( JFILE, HFDLON )
      CALL GZDBWX              !" 精度変換書き込み
     I         ( HHDLON, DLON  ,
     I           IT    , IDATE , ISTEP , ITDUR ,
     I           JFILE , 1     , 0     , HDFMT   )
      CALL GFCLSE( JFILE )
*
      CALL GFWOPN( JFILE, HFLAT  )
      CALL GZDBWX              !" 精度変換書き込み
     I         ( HHLAT , ALAT  ,
     I           IT    , IDATE , ISTEP , ITDUR ,
     I           JFILE , 1     , 0     , HDFMT   )
      CALL GFCLSE( JFILE )
*
      CALL GFWOPN( JFILE, HFDLAT )
      CALL GZDBWX              !" 精度変換書き込み
     I         ( HHDLAT, DLAT  ,
     I           IT    , IDATE , ISTEP , ITDUR ,
     I           JFILE , 1     , 0     , HDFMT   )
      CALL GFCLSE( JFILE )
*
      CALL GFWOPN( JFILE, HFRAD  )
      CALL GZDBWX              !" 精度変換書き込み
     I         ( HHRAD , ARAD   ,
     I           IT    , IDATE , ISTEP , ITDUR ,
     I           JFILE , 1     , 0     , HDFMT   )
      CALL GFCLSE( JFILE )
*
      CALL GFWOPN( JFILE, HFDRAD )
      CALL GZDBWX              !" 精度変換書き込み
     I         ( HHDRAD, DRAD  ,
     I           IT    , IDATE , ISTEP , ITDUR ,
     I           JFILE , 1     , 0     , HDFMT   )
      CALL GFCLSE( JFILE )
*
      STOP
      END