* PACKAGE DG2WD  !" 力学 格子→スペクトル
*
*"  [HIS] 90/08/31(numaguti)
*"        92/05/18(masaaki)       VOR,DIV(LMAX=0) の取扱い変更
*"        98/01/18(akahori)   TENG2W, GD2WD, GUV2VD:  SMPACK-0.0 対応
*"        98/03/07(akahori)   TENG2W, GD2WD, GUV2VD:  SMPACK-1.0 対応
**********************************************************************
      SUBROUTINE TENG2W         !" 時間変化項 ( スペクトル化 )
     O         ( WTVOR , WTDIV , WTT   , WTPI  , WTQ   ,
     I           GTUA  , GTVA  , GTKE  , GTUT  , GTVT  , GTH   ,
     I           GTPI  , GTUQ  , GTVQ  , GTR   ,
     C           FLAPLA                                          )
*
*   [PARAM] 
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数, 波数
#else
#include        "zcdim.F"
#endif
*
*   [OUTPUT]
      REAL       WTVOR ( NMDIM, KMAX      )  !" 渦度  ζ 時間変化
      REAL       WTDIV ( NMDIM, KMAX      )  !" 発散  Ｄ 時間変化
      REAL       WTT   ( NMDIM, KMAX      )  !" 温度  Ｔ 時間変化
      REAL       WTPI  ( NMDIM            )  !" logPs π 時間変化
      REAL       WTQ   ( NMDIM, KMAX      )  !" 比湿  ｑ 時間変化
*
*   [INPUT]
      REAL       GTUA  ( IDIM, JDIM, KMAX )  !" 東西運動量移流項ＵＡ
      REAL       GTVA  ( IDIM, JDIM, KMAX )  !" 南北運動量移流項ＶＡ
      REAL       GTKE  ( IDIM, JDIM, KMAX )  !" 運動エネルギー項ＫＥ
      REAL       GTUT  ( IDIM, JDIM, KMAX )  !" 温度東西移流項  ＵＴ
      REAL       GTVT  ( IDIM, JDIM, KMAX )  !" 温度南北移流項  ＶＴ
      REAL       GTH   ( IDIM, JDIM, KMAX )  !" 温度時間変化項  Ｈ
      REAL       GTPI  ( IDIM, JDIM       )  !" 気圧時間変化項  Ｚ
      REAL       GTUQ  ( IDIM, JDIM, KMAX )  !" 比湿東西移流項  Ｕｑ
      REAL       GTVQ  ( IDIM, JDIM, KMAX )  !" 比湿南北移流項  Ｖｑ
      REAL       GTR   ( IDIM, JDIM, KMAX )  !" 比湿時間変化項  Ｒ
*
      REAL       FLAPLA( NMDIM )             !" ラプラシアンの係数
*
*   [INTERNAL WORK]
      COMMON    /COMWRK/
     &           WTKE
      REAL       WTKE  ( NMDIM     , KMAX )  !" 運動エネルギー項 ＫＥ
*
      INTEGER    K, NM
*
*"         < 1.  渦度 ζ  >
*"         < 2.  発散 Ｄ  >

      CALL DSMV2S
     O     ( WTDIV, WTVOR,
     I       GTUA, GTVA,
     I       'COS ' )
*
*"      ( ＫＥ )
*
      CALL DSMG2S        
     O           ( WTKE  ,
     I             GTKE   )

      DO 2000 K = 1 , KMAX
         DO 2000 NM = 1 , NMDIM
*
*"      ( - ∇・∇ Ｅ )
*
            WTDIV ( NM, K ) =  WTDIV ( NM, K )
     &                          - FLAPLA( NM ) * WTKE( NM, K )
*
 2000 CONTINUE
*
*"         < 3. 温度 Ｔ >
*
*"      ( Ｈ )
*
      CALL DSMG2S
     O         ( WTT   ,
     I           GTH    )
*
*"      ( - ∂(ＶＴ')/∂ｙ )
*"      ( - ∂(ＵＴ')/∂ｘ )
*
      CALL DSMV1S
     M     ( WTT,
     I       GTUT, GTVT,
     I       'COSS' )
*
*"         < 4. 地表面気圧 π >
*
*"      ( Ｚ )
*
      CALL DS1G2S
     O         ( WTPI  ,
     I           GTPI  )
*
*
*"         < 5. 比湿 ｑ >
*
*"      ( Ｒ )
*
      CALL DSMG2S
     O         ( WTQ   ,
     I           GTR    )

*"      ( - ∂(Ｖｑ)/∂ｙ )
*"      ( - ∂(Ｕｑ)/∂ｘ )
!!!!!!  
!!!!!"  この動作は未確認
!!!!!!  
      CALL DSMV1S
     M     ( WTQ,
     I       GTUQ, GTVQ,
     I       'COSS' )

      RETURN
      END
***********************************************************************
      SUBROUTINE GD2WD     !" 予報変数 ( スペクトル化 )
     O         ( WDVOR , WDDIV , WDT   , WDPI  , WDQ   ,
     I           GDVOR , GDDIV , GDT   , GDPS  , GDQ    )
*
*   [PARAM] 
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数, 波数
#else
#include        "zcdim.F"
#endif
*
*   [OUTPUT]
      REAL       WDVOR ( NMDIM , KMAX     )  !" 渦度  ζ
      REAL       WDDIV ( NMDIM , KMAX     )  !" 発散  Ｄ
      REAL       WDT   ( NMDIM , KMAX     )  !" 温度  Ｔ
      REAL       WDPI  ( NMDIM            )  !" log Ps ＝π
      REAL       WDQ   ( NMDIM , KMAX     )  !" 比湿  ｑ
*
*   [INPUT]
      REAL       GDVOR ( IDIM*JDIM, KMAX )   !" 渦度  ζ
      REAL       GDDIV ( IDIM*JDIM, KMAX )   !" 発散  Ｄ
      REAL       GDT   ( IDIM*JDIM, KMAX )   !" 温度  Ｔ
      REAL       GDPS  ( IDIM*JDIM       )   !" 地表気圧 Ｐｓ
      REAL       GDQ   ( IDIM*JDIM, KMAX )   !" 比湿  ｑ
*
*   [INTERNAL WORK]
      COMMON    /COMWRK/
     &           GDPI
      REAL       GDPI  ( IDIM*JDIM       )   !" log Ps ＝π
*
      INTEGER    IJ
*
*"         < 1. 予報変数 ζ,Ｄ,Ｔ, π,ｑ の変換 >
*
      CALL DSMG2S
     O         ( WDVOR   ,
     I           GDVOR    )

      CALL DSMG2S
     O         ( WDDIV   ,
     I           GDDIV    )

      CALL DSMG2S
     O         ( WDT   ,
     I           GDT    )
*
      DO 1300 IJ = 1, IDIM*JDIM
         GDPI ( IJ ) = LOG ( GDPS( IJ ) )
 1300 CONTINUE

      CALL DS1G2S
     O         ( WDPI ,
     I           GDPI  )
*
      CALL DSMG2S
     O         ( WDQ   ,
     I           GDQ    )

      RETURN
      END
***********************************************************************
      SUBROUTINE GUV2VD    !" （Ｕ,Ｖ）格子点 → （ζ,Ｄ） スペクトル
     O         ( WDVOR , WDDIV ,
     I           GDU   , GDV   ,
     C           UVFACT         )
*
*   [PARAM] 
#ifdef SYS_IBMS
      INCLUDE    (ZCDIM)                      !" 格子点数, 波数
#else
#include         "zcdim.F"
#endif
*
*   [OUTPUT]
      REAL       WDVOR ( NMDIM , KMAX     )  !" 渦度  ζ
      REAL       WDDIV ( NMDIM , KMAX     )  !" 発散  Ｄ
*
*   [INPUT]
      REAL       GDU   ( IDIM*JDIM, KMAX )   !" 西風  ｕ
      REAL       GDV   ( IDIM*JDIM, KMAX )   !" 南風  ｖ
      REAL       UVFACT( IDIM*JDIM )         !" u→U のファクター
*
*
*"         < 1. ζ のスペクトル >
*"         < 2. Ｄ のスペクトル >

      CALL DSMV2S
     O     ( WDDIV, WDVOR,
     I       GDU, GDV,
     I       '    ' )

      RETURN
      END
