* PACKAGE DEIVEC  !" 線形力学固有値解析 : 固有関数構造計算
*
*"  [HIS]  92/12/14(takepiro)
*"         93/04/30(takepiro) 複素数の扱いはあっているだろうか
*"         93/07/14(takepiro) ポロイダル, 温度の波数設定分離
*
**********************************************************************
      SUBROUTINE LEIVEC
     O             ( GDU    , GDV    , GDW    , GDT    ,
     O               GDTOR  , GDPOR  , 
     I               EIGVCR , EIGVCI ,
     I               NMKMTX , 
     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)                      !" 格子点数, 波数
#else
#include        "zcdim.F"                    !" 格子点数, 波数
#include        "zldim.F"                    !" 係数行列の大きさ
#endif
*
*"  [OUTPUT]
      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 )  !" ポロイダル Φ
*
*"  [INPUT]
      REAL       EIGVCR( MATDMX )            !" 固有ベクトル実数部
      REAL       EIGVCI( MATDMX )            !" 固有ベクトル虚数部
*
      INTEGER    NMKMTX ( NMDIM, 0:KDIM, 3 ) !" 係数行列の添え字
      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]
c$$$      COMMON     /COMWRK/  
c$$$     &             WDTOR, WDPOR, WDDPOR, WDT 
* 
      REAL       WDTOR ( NMDIM , 0:KDIM     )  !" トロイダル Ψ
      REAL       WDPOR ( NMDIM , 0:KDIM     )  !" ポロイダル Φ
      REAL       WDDPOR( NMDIM , 0:KDIM     )  !" ポロイダル D_l Φ
      REAL       WDT   ( NMDIM , 0:KDIM     )  !" 温度  Ｔ
*
      INTEGER    NML , K 
*
      CALL RESET( WDTOR , NMDIM*KMAX )
      CALL RESET( WDPOR , NMDIM*KMAX )
      CALL RESET( WDDPOR, NMDIM*KMAX )
      CALL RESET( WDT   , NMDIM*KMAX )
*
*"     < 1. 固有ベクトルの計算(スペクトル) >
*
      IF ( OATOR ) THEN
         DO 1100 K = 1, KDIM-1
            DO 1100 NML = 1, NMTMAX
               WDTOR( NMTLST(NML), K ) 
     &              =  EIGVCR( NMKMTX(NML,K,1) ) 
 1100    CONTINUE 
      ENDIF
*
      IF ( OAPOR )THEN
         DO 1200 K = 2, KDIM-2
            DO 1200 NML = 1, NMPMAX
               WDDPOR( NMPLST(NML), K ) 
     &              = EIGVCR( NMKMTX(NML,K,2) ) 
 1200    CONTINUE 
      ENDIF
*
      IF ( OAT ) THEN
         DO 1300 K = 1, KDIM-1
            DO 1300 NML = 1, NMQMAX
               WDT( NMQLST(NML), K ) 
     &              = EIGVCR( NMKMTX(NML,K,3) )
 1300    CONTINUE 
      ENDIF
*
      CALL BNDRY
     M          ( WDTOR , WDPOR , WDT  , WDDPOR, 
     C            FLAPLA,
     C            ARAD  , DRAD                   )
*
*"     < 2. 固有ベクトルの計算(格子) >
*
      CALL GENGD
     O         ( GDU   , GDV   , GDW   , GDT   , 
     O           GDTOR , GDPOR ,
     I           WDTOR , WDPOR , WDT   , 
     C           FLAPLA, UVFACT, 
     C           ARAD  , DRAD                    )
*
      RETURN
      END