* PACKAGE LEIGWR   !" 固有値ファイル書きこみ
*
*"  [HIS] 93/01/20(takepiro)
*
*******************************************************************
      SUBROUTINE EIGWRT     !" パラメター空間への成長率, 振動数出力
     I             (  GROWTH , FRQENC , 
     I                MFIX   , 
     I                REND   , TEND   , PEND   ) 
*
*   [PARAM] 
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数, 波数
      INCLUDE   (ZHDIM)                      !" 文字数
      INCLUDE   (ZLDIM)                      !" パラメター数, 係数行列
#else
#include        "zcdim.F"                    !" 格子点数, 波数
#include        "zhdim.F"                    !" 文字数
#include        "zldim.F"                    !" パラメター数, 係数行列
#endif
*
*   [INPUT]
      REAL       GROWTH( RDIM*TDIM*PDIM )    !" 成長率
      REAL       FRQENC( RDIM*TDIM*PDIM )    !" 振動数
*
      INTEGER    MFIX                        !" 東西波数
      INTEGER    REND                        !" レイリー数の計算数
      INTEGER    TEND                        !" テイラー数の計算数
      INTEGER    PEND                        !" プランドル数の計算数
*
*   [INTERNAL PARM] 
      INTEGER    JFGRW , JFFRQ
      INTEGER    JFGRWD, JFFRQD
      DATA       JFGRWD, JFFRQD / 50 , 51 /
*
      INTEGER    IDATE ( 6 )             !" 日付( ダミー ) 
      INTEGER    ISTEP
      INTEGER    ITDUR
      DATA       IDATE / 1990, 1, 1, 0, 0, 0 /
      DATA       ISTEP / 0 /
      DATA       ITDUR / 1 /
*
      CHARACTER  HDFMT *(NCC)                !" データフォーマット
      DATA       HDFMT / 'UR4' /
      REAL       VMISS                       !" 欠損値の値
*
*   [INTERNAL WORK] 
      CHARACTER  HHGROW( NDC )*(NCC)             !" 成長率ヘッダー
      CHARACTER  HHFREQ( NDC )*(NCC)             !" 振動数ヘッダー
*
      INTEGER    IFPAR , JFPAR                   !" NAMELIST 読み書き
*
      CHARACTER  FNGROW * (NFILN)                !" 成長率出力ファイル名
      CHARACTER  FNFREQ * (NFILN)                !" 振動数出力ファイル名
*
      NAMELIST   / NMEIGN / FNGROW, FNFREQ
*
      INTEGER    IERR                   !" ファイルオープンエラー記述子
*
      LOGICAL    OFIRST
      DATA       OFIRST / .TRUE. /
*
      SAVE
*
      IF( OFIRST )THEN
         OFIRST = .FALSE. 
*
*"         < 1.ファイル名 >
*
         CALL   REWNML ( IFPAR , JFPAR )
         READ   ( IFPAR, NMEIGN , END=1190 )
 1190    WRITE  ( JFPAR, NMEIGN )
*
         CALL IFLOPN
     O         ( JFGRW , IERR  ,
     I           FNGROW, JFGRWD, 'WRITE', 'UNFORMATTED' )
*
         IF( IERR .GT. 0 )THEN
            CALL MSGDMP( 'E', 'EIGWRT', 'CANNOT OPEN FILE' )
         ENDIF
*
         CALL IFLOPN
     O         ( JFFRQ , IERR  ,
     I           FNFREQ, JFFRQD, 'WRITE', 'UNFORMATTED' )
*
         IF( IERR .GT. 0 )THEN
            CALL MSGDMP( 'E', 'EIGWRT', 'CANNOT OPEN FILE' )
         ENDIF
*
      ENDIF
*
*"         < 2. ヘッダー作成 >
*
      CALL GZDBGT( 'MISS' , VMISS )
*
      CALL EIGHED
     O       (  HHGROW , HHFREQ ,
     I          MFIX   , 
     I          REND   , TEND   , PEND  , 
     I          HDFMT  , VMISS  , 
     I          VMISS  , VMISS  , VMISS  , VMISS  , 1 )
*
*"         < 4. ファイル書き込み >
*
      CALL GZDBWX  !" 精度変換書き込み ; 東西波数を時間(day)として書きこむ
     I         ( HHGROW , GROWTH ,
     I           MFIX   , IDATE  , ISTEP , ITDUR ,
     I           JFGRW  , 1      , 0     , HDFMT   )
*
      CALL GZDBWX  !" 精度変換書き込み ; 東西波数を時間(day)として書きこむ
     I         ( HHFREQ , FRQENC ,
     I           MFIX   , IDATE  , ISTEP , ITDUR ,
     I           JFFRQ  , 1      , 0     , HDFMT   )
*
      RETURN
      END
*******************************************************************
      SUBROUTINE EIGHED               !" パラメター空間ヘッダー作成
     O             (  HHGROW , HHFREQ ,
     I                MFIX   , 
     I                REND   , TEND   , PEND  , 
     I                HDFMT  , VMISS  , 
     I                DMIN   , DMAX   , DIVS   , DIVL , ISTYP )
*
*   [PARAM] 
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数, 波数
      INCLUDE   (ZHDIM)                      !" 文字数
      INCLUDE   (ZLDIM)                      !" パラメター数, 係数行列
#else
#include        "zcdim.F"                    !" 格子点数, 波数
#include        "zhdim.F"                    !" 文字数
#include        "zldim.F"                    !" パラメター数, 係数行列
#endif
*
*
*   [OUTPUT]
      CHARACTER  HHGROW ( * ) * ( * )        !" 成長率ヘッダー
      CHARACTER  HHFREQ ( * ) * ( * )        !" 振動数ヘッダー
*
*   [INPUT]
      INTEGER    MFIX                        !" 東西波数
      INTEGER    REND                        !" レイリー数の計算数
      INTEGER    TEND                        !" テイラー数の計算数
      INTEGER    PEND                        !" プランドル数の計算数
*
      CHARACTER  HDFMT  *(*)                 !" データフォーマット
      REAL       VMISS                       !" 欠損値の値
      REAL       DMIN                        !" レンジ(最小)
      REAL       DMAX                        !" レンジ(最大)
      REAL       DIVS                        !" 間隔(小)
      REAL       DIVL                        !" 間隔(大)
      INTEGER    ISTYP                       !" スケーリングタイプ
*
*   [INTERNAL WORK] 
      INTEGER    GRDIM                       !" 配列の大きさ
*
      CHARACTER  HUNIT*(NCC)                 !" 単位
      DATA       HUNIT / '1/s' /
      CHARACTER  HUTIM*(NCC)                 !" 時刻単位
      DATA       HUTIM / 'DAY' /
*
      CHARACTER  HAITM1*(NCC)                !" 軸1の格子名称
      CHARACTER  HAITM2*(NCC)                !" 軸2の格子名称
      CHARACTER  HAITM3*(NCC)                !" 軸3の格子名称
      CHARACTER  HAITMR*(NCC)                !" 軸1の格子名称
      CHARACTER  HAITMT*(NCC)                !" 軸2の格子名称
      CHARACTER  HAITMP*(NCC)                !" 軸3の格子名称
      DATA         HAITMR , HAITMT , HAITMP 
     &           / '.RAYL' , '.TAYL' , '.PRND' /        
*
      CHARACTER  HRUN *(NCC)                !" 実験名
      INTEGER    NHR
      LOGICAL    OFIRST
      DATA       OFIRST / .TRUE. /
*
*   [EXTERNAL FUNC] 
      INTEGER    LENC
*
      SAVE
*
*"        < 0. 軸名称設定 >
*
      IF ( OFIRST ) THEN
         OFIRST = .FALSE.
         CALL GTCGET( 'DDSET' , HRUN    )
         NHR = LENC( HRUN )
         HAITM1 = HRUN(1:NHR) // HAITMR
         HAITM2 = HRUN(1:NHR) // HAITMT
         HAITM3 = HRUN(1:NHR) // HAITMP
      ENDIF
*         
*"         < 1. パラメター設定 >
*
      GRDIM = REND * TEND * PEND
      CALL GTOPEN
      CALL GTSIZE ( HHGROW , GRDIM )
      CALL GTSIZE ( HHFREQ , GRDIM )
*
*"         < 3. ヘッダー設定 >
*
      CALL GZDBHP               !" 識別記述子のパック
     O        (  HHGROW ,
     I           ' '   , 'GROWTH' , 1     , 1     ,
     I           'growth rate' , HUNIT ,
     I           MFIX  , ' '   , HUTIM , 1     ,
     I           HAITM1, 1     , REND  ,
     I           HAITM2, 1     , TEND  ,
     I           HAITM3, 1     , PEND  ,
     I           HDFMT , VMISS ,
     I           DMIN  , DMAX  , DIVS  , DIVL  ,
     I           ISTYP ,
     I           ' '   , ' '                             )
*
      CALL GZDBHP               !" 識別記述子のパック
     O        (  HHFREQ ,
     I           ' '   , 'FRQENC' , 1     , 1     ,
     I           'frequency' , HUNIT ,
     I           MFIX  , ' '   , HUTIM , 1     ,
     I           HAITM1, 1     , REND  ,
     I           HAITM2, 1     , TEND  ,
     I           HAITM3, 1     , PEND  ,
     I           HDFMT , VMISS ,
     I           DMIN  , DMAX  , DIVS  , DIVL  ,
     I           ISTYP ,
     I           ' '   , ' '                             )
*
      RETURN
      END
*******************************************************************
      SUBROUTINE EIALWR     !" 成長率, 振動数全モード出力
     I             (  GROWTH , FRQENC , 
     I                NUMEIG ,  
     I                FNGROW , FNFREQ   ) 
*
*   [PARAM] 
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数, 波数
      INCLUDE   (ZHDIM)                      !" 文字数
      INCLUDE   (ZLDIM)                      !" パラメター数, 係数行列
#else
#include        "zcdim.F"                    !" 格子点数, 波数
#include        "zhdim.F"                    !" 文字数
#include        "zldim.F"                    !" パラメター数, 係数行列
#endif
*
*   [INPUT]
      REAL       GROWTH( NUMEIG )            !" 成長率
      REAL       FRQENC( NUMEIG )            !" 振動数
*
      INTEGER    NUMEIG                      !" 固有値の数
      CHARACTER  FNGROW * (NFILN)            !" 成長率出力ファイル名
      CHARACTER  FNFREQ * (NFILN)            !" 振動数出力ファイル名
*
*
*   [INTERNAL PARM] 
      INTEGER    JFGRW , JFFRQ
      INTEGER    JFGRWD, JFFRQD
      DATA       JFGRWD, JFFRQD / 52 , 53 /
*
      INTEGER    ITA                         !" 通し時間(t), 標準時間単位
      INTEGER    ITB                         !" 通し時間(t-Δt), 標準時間
      INTEGER    IDATEA ( 6 )             !" 日付( ダミー ) 
      INTEGER    IDATEB ( 6 )             !" 日付( ダミー ) 
      INTEGER    ISTEP
      REAL       DELT
      LOGICAL    OADVNC
      INTEGER    ITDUR
      DATA       ITDUR / 1 /
*
      CHARACTER  HDFMT *(NCC)                !" データフォーマット
      DATA       HDFMT / 'UR4' /
      REAL       VMISS                       !" 欠損値の値
*
*   [INTERNAL WORK] 
      CHARACTER  HHGROW( NDC )*(NCC)             !" 成長率ヘッダー
      CHARACTER  HHFREQ( NDC )*(NCC)             !" 振動数ヘッダー
*
      INTEGER    IERR                   !" ファイルオープンエラー記述子
*
      LOGICAL    OFIRST
      DATA       OFIRST / .TRUE. /
*
      SAVE
*
      IF( OFIRST )THEN
         OFIRST = .FALSE. 
*
*"         < 1.ファイルオープン >
*
         CALL IFLOPN
     O         ( JFGRW , IERR  ,
     I           FNGROW, JFGRWD, 'WRITE', 'UNFORMATTED' )
*
         IF( IERR .GT. 0 )THEN
            CALL MSGDMP( 'E', 'EIALWR', 'CANNOT OPEN FILE' )
         ENDIF
*
         CALL IFLOPN
     O         ( JFFRQ , IERR  ,
     I           FNFREQ, JFFRQD, 'WRITE', 'UNFORMATTED' )
*
         IF( IERR .GT. 0 )THEN
            CALL MSGDMP( 'E', 'EIALWR', 'CANNOT OPEN FILE' )
         ENDIF
*
      ENDIF
*
*"         < 2. ヘッダー作成 >
*
      CALL GZDBGT( 'MISS' , VMISS )
*
      CALL EIALHD
     O       (  HHGROW , HHFREQ ,
     I          NUMEIG , 
     I          HDFMT  , VMISS  , 
     I          VMISS  , VMISS  , VMISS  , VMISS  , 1 )
*
*"         < 4. ファイル書き込み >
*
      CALL INQTIM
     O         ( ITA   , ITB   , IDATEA, IDATEB,
     O           ISTEP , DELT  , OADVNC          )
*
      CALL GZDBWX  !" 精度変換書き込み ; パラメターを時間として書きこむ
     I         ( HHGROW , GROWTH ,
     I           ITA    , IDATEA , ISTEP , ITDUR ,
     I           JFGRW  , 1      , 0     , HDFMT   )
*
      CALL GZDBWX  !" 精度変換書き込み ; パラメターを時間として書きこむ
     I         ( HHFREQ , FRQENC ,
     I           ITA    , IDATEA , ISTEP , ITDUR ,
     I           JFFRQ  , 1      , 0     , HDFMT   )
*
      RETURN
      END
*******************************************************************
      SUBROUTINE EIALHD               !" パラメター空間ヘッダー作成
     O             (  HHGROW , HHFREQ ,
     I                NUMEIG , 
     I                HDFMT  , VMISS  , 
     I                DMIN   , DMAX   , DIVS   , DIVL , ISTYP )
*
*   [PARAM] 
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数, 波数
      INCLUDE   (ZHDIM)                      !" 文字数
      INCLUDE   (ZLDIM)                      !" パラメター数, 係数行列
#else
#include        "zcdim.F"                    !" 格子点数, 波数
#include        "zhdim.F"                    !" 文字数
#include        "zldim.F"                    !" パラメター数, 係数行列
#endif
*
*
*   [OUTPUT]
      CHARACTER  HHGROW ( * ) * ( * )        !" 成長率ヘッダー
      CHARACTER  HHFREQ ( * ) * ( * )        !" 振動数ヘッダー
*
*   [INPUT]
      INTEGER    NUMEIG                      !" 固有値の数
*
      CHARACTER  HDFMT  *(*)                 !" データフォーマット
      REAL       VMISS                       !" 欠損値の値
      REAL       DMIN                        !" レンジ(最小)
      REAL       DMAX                        !" レンジ(最大)
      REAL       DIVS                        !" 間隔(小)
      REAL       DIVL                        !" 間隔(大)
      INTEGER    ISTYP                       !" スケーリングタイプ
*
*   [INTERNAL WORK] 
*
      CHARACTER  HUNIT*(NCC)                 !" 単位
      DATA       HUNIT / '1/s' /
      CHARACTER  HUTIM*(NCC)                 !" 時刻単位
      DATA       HUTIM / 'DAY' /
*
      CHARACTER  HAITM1*(NCC)                !" 軸1の格子名称
c$$$      CHARACTER  HAITM2*(NCC)                !" 軸2の格子名称
c$$$      CHARACTER  HAITM3*(NCC)                !" 軸3の格子名称
*
      CHARACTER  HAITMM*(NCC)                !" 軸1の格子名称
      DATA         HAITMM  / '.MODE' /
*
      CHARACTER  HRUN *(NCC)                !" 実験名
      INTEGER    NHR
      LOGICAL    OFIRST
      DATA       OFIRST / .TRUE. /
*
*   [EXTERNAL FUNC] 
      INTEGER    LENC
*
      SAVE
*
*"        < 0. 軸名称設定 >
*
      IF ( OFIRST ) THEN
         OFIRST = .FALSE.
         CALL GTCGET( 'DDSET' , HRUN    )
         NHR = LENC( HRUN )
         HAITM1 = HRUN(1:NHR) // HAITMM
      ENDIF
*         
*"         < 1. パラメター設定 >
*
      CALL GTOPEN
      CALL GTSIZE ( HHGROW , NUMEIG )
      CALL GTSIZE ( HHFREQ , NUMEIG )
*
*"         < 3. ヘッダー設定 >
*
      CALL GZDBHP               !" 識別記述子のパック
     O        (  HHGROW ,
     I           ' '   , 'GROWTH' , 1     , 1     ,
     I           'growth rate' , HUNIT ,
     I           0     , ' '   , HUTIM , 1     ,
     I           HAITM1, 1     , NUMEIG,
     I           ' '   , 1     , 1     ,
     I           ' '   , 1     , 1     ,
     I           HDFMT , VMISS ,
     I           DMIN  , DMAX  , DIVS  , DIVL  ,
     I           ISTYP ,
     I           ' '   , ' '                             )
*
      CALL GZDBHP               !" 識別記述子のパック
     O        (  HHFREQ ,
     I           ' '   , 'FRQENC' , 1     , 1     ,
     I           'frequency' , HUNIT ,
     I           0     , ' '   , HUTIM , 1     ,
     I           HAITM1, 1     , NUMEIG,
     I           ' '   , 1     , 1     ,
     I           ' '   , 1     , 1     ,
     I           HDFMT , VMISS ,
     I           DMIN  , DMAX  , DIVS  , DIVL  ,
     I           ISTYP ,
     I           ' '   , ' '                             )
*
      RETURN
      END
