* PACKAGE LHIST   !" 固有値ヒストリー出力
*"                  (最大)成長率, 振動数を 3 次元データ(R,T,P)の形で登録
*
*"  [HIS] 93/01/20(takepiro)
*
*******************************************************************
      SUBROUTINE LHSEIN 
     I             (  GRMAX  , FREQ   , 
     I                MFIX   , 
     I                RSTEP  , TSTEP  , PSTEP  ) 
*
*   [PARAM] 
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数, 波数
      INCLUDE   (ZLDIM)                      !" パラメター数, 係数行列
#else
#include        "zcdim.F"                    !" 格子点数, 波数
#include        "zldim.F"                    !" パラメター数, 係数行列
#endif
*
*  [INPUT]
      REAL       GRMAX                       !" (最大)成長率
      REAL       FREQ                        !" 振動数
*
      INTEGER    MFIX                        !" 東西波数
      INTEGER    RSTEP                       !" レイリー数のステップ数
      INTEGER    TSTEP                       !" テイラー数のステップ数
      INTEGER    PSTEP                       !" プランドル数のステップ数
      INTEGER    REND                        !" レイリー数の計算数
      INTEGER    TEND                        !" テイラー数の計算数
      INTEGER    PEND                        !" プランドル数の計算数
*  [ENTRY INPUT]
      REAL       RAYL                        !" (臨界)レイリー数
*
*  [INTERNAL WORK]
      REAL       RAYLC ( RDIM , TDIM , PDIM ) !" 臨界レイリー数
      REAL       GROWTH( RDIM , TDIM , PDIM ) !" 成長率
      REAL       FRQENC( RDIM , TDIM , PDIM ) !" 振動数
      REAL       WORKG ( RDIM * TDIM * PDIM ) !" 作業配列
      REAL       WORKF ( RDIM * TDIM * PDIM ) !" 作業配列
*
      INTEGER    I, IR, IT, IP
*
      SAVE      GROWTH, FRQENC, RAYLC
*
      GROWTH ( RSTEP , TSTEP , PSTEP ) = GRMAX
      FRQENC ( RSTEP , TSTEP , PSTEP ) = FREQ

      RETURN
*======================================================================
      ENTRY LHSRIN 
     I        (  RAYL   , 
     I           MFIX   , 
     I           RSTEP  , TSTEP  , PSTEP  ) 
*
      RAYLC ( RSTEP , TSTEP , PSTEP ) = RAYL
      RETURN
**********************************************************************
      ENTRY LHSREO
     I        (  MFIX   , 
     C           REND   , TEND   , PEND   ) 
*
      DO 1000 IP = 1, PEND
         DO 1000 IT = 1, TEND
            DO 1000 IR = 1, REND
               I = IR + REND * ( IT-1 ) + REND * TEND * ( IP-1 )
               WORKG( I ) = RAYLC( IR, IT, IP )
 1000 CONTINUE 
*
      CALL LRCWRT
     I        (  WORKG  , 
     I           MFIX   , 
     I           REND   , TEND   , PEND   ) 
*
*======================================================================
      ENTRY LHSEOU
     I        (  MFIX   , 
     C           REND   , TEND   , PEND   ) 
*
      DO 2000 IP = 1, PEND
         DO 2000 IT = 1, TEND
            DO 2000 IR = 1, REND
               I = IR + REND * ( IT-1 ) + REND * TEND * ( IP-1 )
               WORKG( I ) = GROWTH( IR, IT, IP )
               WORKF( I ) = FRQENC( IR, IT, IP )
 2000 CONTINUE 
*
       CALL EIGWRT
     I       (  WORKG  , WORKF  , 
     I          MFIX   , 
     I          REND   , TEND   , PEND   ) 
*
       RETURN
       END




