* PACKAGE DEDIAG  !" 線形力学固有値解析 : 固有値計算診断出力
*
*"  [HIS]  92/12/28(takepiro) 
*"         93/04/30(takepiro)
*"         93/07/14(takepiro) ポロイダル, 温度の波数設定分離
*
**********************************************************************
      SUBROUTINE LDIAG
     I            (  GROWTH , FRQENC , 
     I               EIGVCR , EIGVCI ,
     I               NMKMTX , NUMEIG , 
     I               NMTLST , NMTMAX , 
     I               NMPLST , NMPMAX , 
     I               NMQLST , NMQMAX , 
     F               OATOR  , OAPOR  , OAT    ,
     C               NMO    , FLAPLA , UVFACT , 
     C               ARAD   , DRAD                       )
*
*   [PARAM]
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数, 波数
      INCLUDE   (ZLDIM)                      !" 格子点数, 波数
      INCLUDE   (ZHDIM)                      !" 文字数
#else
#include        "zcdim.F"                    !" 格子点数, 波数
#include        "zldim.F"                    !" 係数行列の大きさ
#include        "zhdim.F"                    !" 文字数
#endif
*
*"  [INPUT]
      REAL       GROWTH( MATDMX )            !" 成長率(固有値実数部)
      REAL       FRQENC( MATDMX )            !" 振動数(固有値虚数部)
      REAL       EIGVCR( MATDMX, MATDMX )    !" 固有ベクトル実数部
      REAL       EIGVCI( MATDMX, MATDMX )    !" 固有ベクトル虚数部
*
      INTEGER    NMKMTX ( NMDIM, 0:KDIM, 3 ) !" 係数行列の添え字
      INTEGER    NUMEIG                      !" 固有値の数
      INTEGER    NMTLST  ( NMDIM )           !" MFIX 成分リスト(トロイダル)
      INTEGER    NMPLST  ( NMDIM )           !" MFIX 成分リスト(ポロイダル)
      INTEGER    NMQLST  ( NMDIM )           !" MFIX 成分リスト(温度)
      INTEGER    NMTMAX                      !" NMTLST の最大添え字
      INTEGER    NMPMAX                      !" NMPLST の最大添え字
      INTEGER    NMQMAX                      !" NMQLST の最大添え字
*
      LOGICAL    OATOR , OAPOR , OAT         !" 解析対象物理量
      INTEGER    NMO   ( 2, 0:MMAX, 0:LMAX ) !" スペクトルの添字順番
      REAL       FLAPLA( NMDIM  )            !" ラプラシアンの係数
      REAL       UVFACT ( IDIM, JDIM )       !" u→U のファクター
*
      REAL       ARAD  ( 0:KDIM )              !" ｒレベル(整数)
      REAL       DRAD  ( 0:KDIM )              !" Δｒ(整数)
*
*   [INTERNAL WORK]
      REAL       GDU   ( IDIM, JDIM, 0:KDIM )  !" 西風   ｕ
      REAL       GDV   ( IDIM, JDIM, 0:KDIM )  !" 南風   ｖ
      REAL       GDW   ( IDIM, JDIM, 0:KDIM )  !" 鉛直風 ｗ
      REAL       GDT   ( IDIM, JDIM, 0:KDIM )  !" 温度   Ｔ
      REAL       GDTOR ( IDIM, JDIM, 0:KDIM )  !" トロイダル Ψ
      REAL       GDPOR ( IDIM, JDIM, 0:KDIM )  !" ポロイダル Φ
*
      INTEGER    I, ITA
      LOGICAL    OLDIAG, OLDIAF, OLDIAV
      CHARACTER  FNGROW * (NFILN)       !" 成長率出力ファイル名
      CHARACTER  FNFREQ * (NFILN)       !" 振動数出力ファイル名
*
      CHARACTER  HFMT*16
      INTEGER    JFLDIA, NCOLS, ISTR, IEND, IINT
*
      DATA       HFMT    / '(1PE12.4)' /           !" 出力書式
      DATA       JFLDIA  / 6 /                     !" 出力装置番号
      DATA       NCOLS   / 80 /                    !" 出力カラム数
      DATA       ISTR    / 1 /                     !" 出力開始
      DATA       IEND    / 1 /
      DATA       IINT    / 1 /                     !" 出力間隔
*
      LOGICAL    OEIAXS
      DATA       OEIAXS / .TRUE. /
      SAVE
*
*"  < 1. 出力のパラメター設定 >
*
      CALL QLDIAG
     O     (  OLDIAG , OLDIAF, OLDIAV , 
     O        FNGROW , FNFREQ             ) 
*
      IEND = NUMEIG 
*
*"  < 2. 固有値診断出力 >
*
      IF( OLDIAG )THEN
*
         WRITE ( JFLDIA, * ) '@@@@@@@@@@@@< GROWTH RATE ',
     &                       '>@@@@@@@@@@@@@'
*
         CALL PRINTD
     I         ( JFLDIA , HFMT  , GROWTH ,
     I           ISTR   , IEND  , IINT   , 1 ,
     I           MATDMX , 1     , NCOLS          )
*
         WRITE ( JFLDIA, * ) '@@@@@@@@@@@@< FREQUENCY ', 
     &                       '>@@@@@@@@@@@@@'
*
         CALL PRINTD
     I         ( JFLDIA , HFMT  , FRQENC ,
     I           ISTR   , IEND  , IINT   , 1 ,
     I           MATDMX , 1     , NCOLS          )
*
      ENDIF
*
*"  < 3. 固有値ファイル出力 >
*
      IF( OLDIAF )THEN
         IF( OEIAXS )THEN
            OEIAXS = .FALSE. 
            CALL EIGAXS
     I           ( NUMEIG )
         ENDIF
*
         CALL EIALWR     !" 成長率, 振動数全モード出力
     I        (  GROWTH , FRQENC , 
     I           NUMEIG ,  
     I           FNGROW , FNFREQ   ) 
      ENDIF
*
*"  < 4. 固有関数出力 >
*
      IF( OLDIAV )THEN
         DO 1000 I = 1, NUMEIG
            ITA = I
*
            CALL LEIVEC
     O       ( GDU    , GDV    , GDW    , GDT    ,
     O         GDTOR  , GDPOR  , 
     I         EIGVCR(1,I) , EIGVCI(1,I) ,
     I         NMKMTX , 
     I         NMTLST , NMTMAX , 
     I         NMPLST , NMPMAX , 
     I         NMQLST , NMQMAX , 
     F         OATOR  , OAPOR  , OAT    ,
     C         NMO    , FLAPLA , UVFACT , 
     C         ARAD   , DRAD                       )
*
            CALL WRRSTR         !" リスタート・ファイルの書き込み
     I         ( GDU   , GDV   , GDW   , GDT   , 
     I           GDTOR , GDPOR ,
     I           ITA   , ITA                     )
*
 1000    CONTINUE 
      ENDIF
*
      RETURN
      END
**********************************************************************
      SUBROUTINE QLDIAG
     O           (  OLDIAG , OLDIAF, OLDIAV , 
     O              FNGR   , FNFR             ) 
*
*
*   [PARAM] 
#ifdef SYS_IBMS
      INCLUDE   (ZHDIM)                      !" 文字数
#else
#include        "zhdim.F"                    !" 文字数
#endif
**  [OUTPUT]
      LOGICAL    OLDIAG                 !" 固有値診断出力スイッチ
      LOGICAL    OLDIAF                 !" 固有値ファイル出力スイッチ
      LOGICAL    OLDIAV                 !" 固有関数ファイル出力スイッチ
      CHARACTER  FNGR * (NFILN)         !" 成長率出力ファイル名
      CHARACTER  FNFR * (NFILN)         !" 振動数出力ファイル名
*
*  [INTERNAL WORK]
      LOGICAL    OEIGEN                 !" 固有値診断出力スイッチ
      LOGICAL    OEIGFI                 !" 固有値ファイル出力スイッチ
      LOGICAL    OEIVEC                 !" 固有関数ファイル出力スイッチ
      CHARACTER  FNGROW * (NFILN)       !" 成長率出力ファイル名
      CHARACTER  FNFREQ * (NFILN)       !" 振動数出力ファイル名
*
      NAMELIST   / NMLDIA / OEIGEN, OEIGFI, OEIVEC, FNGROW, FNFREQ
*
      INTEGER    IFPAR, JFPAR
      LOGICAL    OFIRST
      DATA       OFIRST  / .TRUE. /
*
      SAVE
*
*"         < 1. NAMELIST の読み込み >
*
      IF( OFIRST )THEN
         OFIRST = .FALSE.
*
         OEIGEN = .TRUE.
         OEIGFI = .FALSE.
         OEIVEC = .FALSE.
         FNGROW = ' '
         FNFREQ = ' '
*
         CALL   REWNML ( IFPAR , JFPAR )
         READ   ( IFPAR, NMLDIA, END=1190 )
 1190    WRITE  ( JFPAR, NMLDIA  )
      ENDIF
*
      OLDIAG = OEIGEN
      OLDIAF = OEIGFI
      OLDIAV = OEIVEC
      FNGR   = FNGROW
      FNFR   = FNFREQ
*
      RETURN
      END