* PACKAGE XMKAXIS    !" 座標軸ファイル出力
*
*"  [HIS] 95/08/18 (takepiro) 
***********************************************************************
      PROGRAM XMKAXS
*
* [PARAM]
#include        "zcdim.F"            !" 格子点数, 波数
#include        "zhdim.F"            !" 文字列文字数
*
*" 座標計算用
      REAL     DX                   !" X 軸上の格子点間隔
      REAL     DZ                   !" Z 軸上の格子点間隔
      REAL     XCLOC( NX+1 )        !" X 軸格子位置
      REAL     XCWGT( NX+1 )        !" X 軸格子重み
      REAL     ZCLOC( 0:NZ+1 )      !" Z 軸格子位置
      REAL     ZCWGT( 0:NZ+1 )      !" Z 軸格子重み
      INTEGER  IX , IZ
*
*" 軸ファイル名
      CHARACTER HCORX*(NCC)     !" X 座標軸名
      CHARACTER HCORZ*(NCC)     !" Z 座標軸名
*
      CHARACTER HFXLOC*(NFILN)    !" X 座標格子位置ファイル名
      CHARACTER HFXWGT*(NFILN)    !" X 座標格子重みファイル名
      CHARACTER HFZLOC*(NFILN)    !" Z 座標格子位置ファイル名
      CHARACTER HFZWGT*(NFILN)    !" Z 座標格子重みファイル名
*
      CHARACTER HALOC*(NFILN)     !"格子位置ファイル接頭子
      CHARACTER HAWGT*(NFILN)     !"格子重みファイル接頭子
*
      INTEGER   NHX, NHZ, NHL, NHW
      INTEGER   LENC            !" dennou math1 関数
*
*" ヘッダー作成
      CHARACTER HEADXL (NDC)*(NCC) !" ヘッダー
      CHARACTER HEADXW (NDC)*(NCC) !" ヘッダー
      CHARACTER HEADZL (NDC)*(NCC) !" ヘッダー
      CHARACTER HEADZW (NDC)*(NCC) !" ヘッダー
*
      CHARACTER HKIND * (NCC)   !" 格子情報の種類
      CHARACTER HITEM * (NCC)   !" 格子識別名称
      CHARACTER HTITL * (NCC)   !" 軸タイトル
      CHARACTER HUNIT * (NCC)   !" 単位
      INTEGER   IXDIM           !" 格子数
      CHARACTER HDFMT * (NCC)   !" データフォーマット
      REAL      VMISS           !" 欠損値の値
      REAL      DMIN            !" レンジ(最小)
      REAL      DMAX            !" レンジ(最大)
      REAL      DIVS            !" 間隔(小)
      REAL      DIVL            !" 間隔(大)
      INTEGER   ISTYP           !" スケーリングタイプ
*
c$$$      REAL*4    RGNLE           !" dennou math1 関数
*
      CHARACTER  SIGN *(NCC)    !" 実験者名
      DATA  SIGN / 'momoko' /
*
*"      << 1. 座標軸の計算 >>
*
      CALL GTCSET( 'MYSIGN', SIGN   )
*
      CALL ACRSET               !" 座標設定
*
      CALL ACRGET               !" 座標値
     O       (  DX , DZ  )
*
      DO 1000 IX = 0, NX+1
         XCLOC( IX ) = DX*(IX-1)
 1000 CONTINUE 
      CALL SETV( XCWGT , DX , NX+1 )
*
      DO 1100 IZ = 0, NZ+1 
         ZCLOC( IZ ) = DZ*IZ
 1100 CONTINUE 
      CALL SETV( ZCWGT , DZ , NZ+2 )
      ZCWGT( 0 )    = DZ/2
      ZCWGT( NZ+1 ) = DZ/2
*
*"     << 2. 軸ファイル名 >>
*
      CALL ACNGET               !" 座標軸名
     O       ( HCORX , HCORZ )
*
      CALL CLADJ( HCORX )
      NHX = LENC( HCORX )
      CALL CLADJ( HCORZ )
      NHZ = LENC( HCORZ )
*
c$$$      CALL GTCGET( 'FAXLOC', HALOC )  !" 名前に軸ファイルの path 名が入る
c$$$      CALL GTCGET( 'FAXWGT', HAWGT )
      CALL GTCGET( 'FAXLOC1', HALOC )   !" 名前に path 名が入らない
      CALL GTCGET( 'FAXWGT1', HAWGT )
      NHL = LENC( HALOC )
      NHW = LENC( HAWGT )
*
      HFXLOC = HALOC(1:NHL)//HCORX(1:NHX)
      HFXWGT = HAWGT(1:NHW)//HCORX(1:NHX)
      HFZLOC = HALOC(1:NHL)//HCORZ(1:NHZ)
      HFZWGT = HAWGT(1:NHW)//HCORZ(1:NHZ)
*
*"      << 3. ヘッダー作成 >>
*
*"          < 3.1 X 座標 >
*
*"    CALL GTPGET
      CALL ZTPGET                       !" 自動倍精度対応ルーチン
     I      ( 'MISS',
     O         VMISS  )
*
      HKIND = 'CAXLOC'
      HITEM = 'X'
      HTITL = 'X-Coordinate'
      HUNIT = 'Non-dim'
      IXDIM = NX
      HDFMT = 'UR4'
      DMIN  = XCLOC(1)
      DMAX  = XCLOC(NX+1)
      DIVS  = (DMAX - DMIN) / 4
      DIVL  = (DMAX - DMIN) / 2 
      ISTYP = 1
*
*"    CALL GHPACA
      CALL ZHPACA                       !" 自動倍精度対応ルーチン
     O         ( HEADXL,
     I           HKIND , HITEM ,
     I           HTITL , HUNIT ,
     I           IXDIM ,
     I           HDFMT , VMISS ,
     I           DMIN  , DMAX  , DIVS  , DIVL  , ISTYP  )
*
      HKIND = 'CAXWGT'
*
*"    CALL GHPACA
      CALL ZHPACA                       !" 自動倍精度対応ルーチン
     O         ( HEADXW,
     I           HKIND , HITEM ,
     I           HTITL , HUNIT ,
     I           IXDIM ,
     I           HDFMT , VMISS ,
     I           DMIN  , DMAX  , DIVS  , DIVL  , ISTYP  )
*
*"          < 3.2 Z 座標 >
*
      HKIND = 'AXLOC'
      HITEM = 'Z'
      HTITL = 'Z-Coordinate'
      HUNIT = 'Non-dim'
      IXDIM = NZ+2
      HDFMT = 'UR4'
      DMIN  = ZCLOC(0)
      DMAX  = ZCLOC(NZ+1)
      DIVS  = (DMAX - DMIN) / 20 
      DIVL  = (DMAX - DMIN) / 4 
      ISTYP = 1
*
*"    CALL GHPACA
      CALL ZHPACA                       !" 自動倍精度対応ルーチン
     O         ( HEADZL,
     I           HKIND , HITEM ,
     I           HTITL , HUNIT ,
     I           IXDIM ,
     I           HDFMT , VMISS ,
     I           DMIN  , DMAX  , DIVS  , DIVL  , ISTYP  )
*
      HKIND = 'AXWGT'
*
*"    CALL GHPACA
      CALL ZHPACA                       !" 自動倍精度対応ルーチン
     O         ( HEADZW,
     I           HKIND , HITEM ,
     I           HTITL , HUNIT ,
     I           IXDIM ,
     I           HDFMT , VMISS ,
     I           DMIN  , DMAX  , DIVS  , DIVL  , ISTYP  )
*
*"      << 4. 軸ファイル出力 >>
*
      CALL WRTAXS
     I     ( HFXLOC , HEADXL , XCLOC )
      CALL WRTAXS
     I     ( HFXWGT , HEADXW , XCWGT )
      CALL WRTAXS
     I     ( HFZLOC , HEADZL , ZCLOC )
      CALL WRTAXS
     I     ( HFZWGT , HEADZW , ZCWGT )
*
      STOP
      END
***********************************************************************
      SUBROUTINE WRTAXS
     I           ( HFILE , HHEAD , GDATA )
*
* [INPUT]
      CHARACTER HFILE*(*)
      CHARACTER HHEAD(*)*(*)
      REAL      GDATA(*)
*
* [INTERNAL WORK]
      INTEGER JFILE
      DATA    JFILE /50/
*
      CALL GFWOPN
     M     ( JFILE , 
     I       HFILE  )
*
*"    CALL GFWRIT
      CALL ZFWRIT                       !" 自動倍精度対応ルーチン
     I     ( HHEAD , GDATA ,
     I       JFILE ,    1  , 0  )
*
      CALL GFCLSE( JFILE )
*
      RETURN
      END