*"   PACKAGE  
* PACKAGE XMKAXIS   !" GTOOL3 軸ファイルの作成
*
*"        94/06/20(ishiwatari) log σ 軸追加
*******************************************************************
      PROGRAM MKAXIS  !" GTOOL3 軸ファイルの作成
*
*   [PARAM] 
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数, 波数
      INCLUDE   (GZSIZE)
#else
#include        "zcdim.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  HHSIG ( NDC )*(NCC)
      REAL       SIG   ( KMAX )
      CHARACTER  HHDSIG( NDC )*(NCC)
      REAL       DSIG  ( KMAX )
      CHARACTER  HHSIGM( NDC )*(NCC)
      REAL       SIGM  ( KMAX+1 )
      CHARACTER  HHDSGM( NDC )*(NCC)
      REAL       DSIGM ( KMAX+1 )
*" 以下追加
      CHARACTER  HHLSIG( NDC )*(NCC)
      REAL       LSIG  ( KMAX )
      CHARACTER  HHDLSG( NDC )*(NCC)
      REAL       DLSIG ( KMAX )
      CHARACTER  HHLSGM( NDC )*(NCC)
      REAL       LSIGM ( KMAX+1 )
      CHARACTER  HHDLSM( NDC )*(NCC)
      REAL       DLSIGM( KMAX+1 )
*" 以上追加
*
      CHARACTER  HALON        *(NCC)  !" 軸名称(経度)
      CHARACTER  HALAT        *(NCC)
      CHARACTER  HASIG        *(NCC)
      CHARACTER  HASIGM       *(NCC)
      CHARACTER  HALOC        *(NFILN)
      CHARACTER  HAWGT        *(NFILN)
*" 以下追加
      CHARACTER  HALSIG       *(NCC)
      CHARACTER  HALSGM       *(NCC)
*" 以上追加
*
      CHARACTER  HFLON  *(NFILN)      !" ファイル名(経度)
      CHARACTER  HFDLON *(NFILN)
      CHARACTER  HFLAT  *(NFILN)
      CHARACTER  HFDLAT *(NFILN)
      CHARACTER  HFSIG  *(NFILN)
      CHARACTER  HFDSIG *(NFILN)
      CHARACTER  HFSIGM *(NFILN)
      CHARACTER  HFDSGM *(NFILN)
*" 以下追加
      CHARACTER  HFLSIG *(NFILN)
      CHARACTER  HFDLSG *(NFILN)
      CHARACTER  HFLSGM *(NFILN)
      CHARACTER  HFDLSM *(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 GTOPEN
      CALL GTSIZE ( HHLON , IMAX+1 )
      CALL GTSIZE ( HHDLON, IMAX+1 )
      CALL GTSIZE ( HHLAT , JMAX   )
      CALL GTSIZE ( HHDLAT, JMAX   )
      CALL GTSIZE ( HHSIG , KMAX   )
      CALL GTSIZE ( HHDSIG, KMAX   )
      CALL GTSIZE ( HHSIGM, KMAX+1 )
      CALL GTSIZE ( HHDSGM, KMAX+1 )
*" 以下追加
      CALL GTSIZE ( HHLSIG, KMAX   )
      CALL GTSIZE ( HHDLSG, KMAX   )
      CALL GTSIZE ( HHLSGM, KMAX+1 )
      CALL GTSIZE ( HHDLSM, KMAX+1 )
*" 以上追加
*
*"         < 1. 格子点設定 >
*
*
      CALL PCONST
*
      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 SETSIG
     O         ( SIG   , DSIG  , HASIG ,
     O           SIGM  , DSIGM , HASIGM,
     D           KMAX  , KMAX            )
*
      CALL SETLSG
     O         ( LSIG  , DLSIG , HALSIG,
     O           LSIGM , DLSIGM, HALSGM,
     I           SIG   , SIGM  ,
     D           KMAX  , KMAX            )
*
*"         < 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
      HFSIG  = HALOC(1:NHL)//HASIG
      HFDSIG = HAWGT(1:NHW)//HASIG
      HFSIGM = HALOC(1:NHL)//HASIGM
      HFDSGM = HAWGT(1:NHW)//HASIGM
*" 以下追加
      HFLSIG = HALOC(1:NHL)//HALSIG
      HFDLSG = HAWGT(1:NHW)//HALSIG
      HFLSGM = HALOC(1:NHL)//HALSGM
      HFDLSM = HAWGT(1:NHW)//HALSGM
*" 以上追加
*
*"         < 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         ( HHSIG ,
     I           'AXLOC', HASIG ,
     I           'sigma'       , ' '   , KMAX ,
     I           'UR4' ,  VMISS,
     I              0. ,    1. ,  0.1  ,  0.2  , -1    )
*
      CALL GHCOPY ( HHSIG , HHDSIG )
      CALL GHCSET ( HHDSIG, 'DSET', 'AXWGT' )
*
      CALL GZDBAP
     O         ( HHSIGM,
     I           'AXLOC', HASIGM,
     I           'sigma'       , ' '   , KMAX+1,
     I           'UR4' ,  VMISS ,
     I              0. ,    1. ,  0.1  ,  0.2  , -1    )
*
      CALL GHCOPY ( HHSIGM, HHDSGM )
      CALL GHCSET ( HHDSGM, 'DSET', 'AXWGT' )
*" 以下追加
      CALL GZDBAP
     O         ( HHLSIG ,
     I           'AXLOC', HALSIG ,
     I           'log sigma'     , ' '   , KMAX ,
     I           'UR4' ,  VMISS,
     I              -6.,    0. , 1.0  ,  0.5  , -1    )
*
      CALL GHCOPY ( HHLSIG , HHDLSG )
      CALL GHCSET ( HHDLSG , 'DSET', 'AXWGT' )
*
      CALL GZDBAP
     O         ( HHLSGM,
     I           'AXLOC', HALSGM,
     I           'log sigma'       , ' '   , KMAX+1,
     I           'UR4' ,  VMISS ,
     I              -6.,    0. , 1.0  ,  0.5  , -1    )
*
      CALL GHCOPY ( HHLSGM, HHDLSM )
      CALL GHCSET ( HHDLSM, '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, HFSIG  )
      CALL GZDBWX              !" 精度変換書き込み
     I         ( HHSIG , SIG   ,
     I           IT    , IDATE , ISTEP , ITDUR ,
     I           JFILE , 1     , 0     , HDFMT   )
      CALL GFCLSE( JFILE )
*
      CALL GFWOPN( JFILE, HFDSIG )
      CALL GZDBWX              !" 精度変換書き込み
     I         ( HHDSIG, DSIG  ,
     I           IT    , IDATE , ISTEP , ITDUR ,
     I           JFILE , 1     , 0     , HDFMT   )
      CALL GFCLSE( JFILE )
*
      CALL GFWOPN( JFILE, HFSIGM )
      CALL GZDBWX              !" 精度変換書き込み
     I         ( HHSIGM, SIGM  ,
     I           IT    , IDATE , ISTEP , ITDUR ,
     I           JFILE , 1     , 0     , HDFMT   )
      CALL GFCLSE( JFILE )
*
      CALL GFWOPN( JFILE, HFDSGM )
      CALL GZDBWX              !" 精度変換書き込み
     I         ( HHDSGM, DSIGM ,
     I           IT    , IDATE , ISTEP , ITDUR ,
     I           JFILE , 1     , 0     , HDFMT   )
      CALL GFCLSE( JFILE )
*
*" 以下追加
      CALL GFWOPN( JFILE, HFLSIG  )
      CALL GZDBWX              !" 精度変換書き込み
     I         ( HHLSIG , LSIG   ,
     I           IT    , IDATE , ISTEP , ITDUR ,
     I           JFILE , 1     , 0     , HDFMT   )
      CALL GFCLSE( JFILE )
*
      CALL GFWOPN( JFILE, HFDLSG )
      CALL GZDBWX              !" 精度変換書き込み
     I         ( HHDLSG, DLSIG  ,
     I           IT    , IDATE , ISTEP , ITDUR ,
     I           JFILE , 1     , 0     , HDFMT   )
      CALL GFCLSE( JFILE )
*
      CALL GFWOPN( JFILE, HFLSGM )
      CALL GZDBWX              !" 精度変換書き込み
     I         ( HHLSGM, LSIGM  ,
     I           IT    , IDATE , ISTEP , ITDUR ,
     I           JFILE , 1     , 0     , HDFMT   )
      CALL GFCLSE( JFILE )
*
      CALL GFWOPN( JFILE, HFDLSM )
      CALL GZDBWX              !" 精度変換書き込み
     I         ( HHDLSM, DLSIGM,
     I           IT    , IDATE , ISTEP , ITDUR ,
     I           JFILE , 1     , 0     , HDFMT   )
      CALL GFCLSE( JFILE )
*" 以上追加
*
      STOP
      END
***********************************************************************
       SUBROUTINE SETLSG
     O         ( LSIG  , DLSIG , HALSIG,
     O           LSIGM , DLSIGM, HALSGM,
     I           SIG   , SIGM  ,
     D           KMAX  , KDIM            )
*
*   [PARAM]
       INTEGER   KMAX, KDIM
*
*   [INPUT]
       REAL SIG  (KDIM)
       REAL SIGM (KDIM+1)
*
*   [OUTPUT]
       REAL      LSIG  (KDIM)
       REAL      LSIGM (KDIM+1)
       REAL      DLSIG (KDIM)
       REAL      DLSIGM(KDIM+1)
       CHARACTER HALSIG *(*)
       CHARACTER HALSGM *(*)
*
*   [INTERNAL WORK]
#ifdef SYS_IBMS
      INCLUDE   (ZHDIM)
#else
#include        "zhdim.F"
#endif
       INTEGER   K
*
*   [INTERNAL PARAM]
       CHARACTER HASIG1 *(NCC)
       DATA      HASIG1 / 'LSIG'  /
       REAL      MINNUM
       DATA      MINNUM / 1.17E-38 /
*
      CALL SETLSX
     M     ( LSIGM ,
     O       HALSIG, HALSGM,
     I       HASIG1, KMAX  )
*
*"       < 1. log σ >
*
       DO 1100 K = 1,KMAX
          write(6,*) k,sig(k)
          LSIG (K) = LOG10( SIG(K) )
 1100  CONTINUE 
       DO 1200 K = 1,KMAX
          write(6,*) k,sigm(k)
          LSIGM (K) = LOG10( SIGM(K) )
 1200  CONTINUE 
       LSIGM ( KMAX+1 ) = LOG( MINNUM )
*
*" 重みの定義は以下で良いのか！？
*
       DO 1300 K = 1, KMAX
          DLSIG (K) = LSIGM ( K ) - LSIGM ( K+1 )
 1300  CONTINUE 
       DO 1400 K = 2, KMAX
          DLSIGM (K) = LSIG ( K-1 ) - LSIG ( K )
 1400  CONTINUE 
       DLSIGM ( 1 ) = LSIGM ( 1 ) - LSIG( 1 )
       DLSIGM ( KMAX+1 ) = LSIG ( KMAX ) - LSIGM( KMAX+1 )
*
*" 重みの定義は以上で良いのか！？
*
       RETURN
       END
***********************************************************************
      SUBROUTINE SETLSX
     M     ( LSIGM,
     O       HALSIG, HALSGM,
     I       HASIG1, KMAX)
*
*   [PARAM]
      INTEGER KMAX
*
*   [MODIFY]
      REAL LSIGM ( * )
*
*   [OUTPUT]
      CHARACTER HALSIG *(*)
      CHARACTER HALSGM *(*)
*
*   [INPUT]
      CHARACTER HASIG1 *(*)
*
*   [INTERNAL WORK]
#ifdef SYS_IBMS
      INCLUDE   (ZHDIM)
#else
#include        "zhdim.F"
#endif
      INTEGER INUM, IAZ
*
*   [INTERNAL PARAM]
      CHARACTER HASI0Z *(NCC)
      CHARACTER HNUM   *(NCC)
*
*   [EXTERNAL FUNC]
      INTEGER LENC
*
*"     < 1. 名称セット >
      CALL GULCHR
     I      ( '(I4)', KMAX ,
     O        HNUM  , INUM )
*
      HASI0Z = HASIG1
*
      IAZ = LENC( HASI0Z )
      HALSIG = HASI0Z(1:IAZ)//HNUM(1:INUM)//'.P'
      HALSGM = HASI0Z(1:IAZ)//HNUM(1:INUM)//'.M'
*
      RETURN
      END
