*"表題   SHALO 力学 格子→スペクトル GCM5(SDG2WD)
*
*"履歴   90/08/31 沼口  敦
*"       92/06/11 竹広真一
*"       92/11/14 竹広真一
*
*
**********************************************************************
*"            << 時間変化項 ( スペクトル化 ) >>
**********************************************************************
      SUBROUTINE TENG2W
     O         ( WTVOR , WTDIV , WTPHI ,
     I           GTUA  , GTVA  , GTKE  , GTUP  , GTVP  , GTH   ,
     C           FLAPLA                                          )
*
#if   SYS_IBMS
      INCLUDE   (ZCDIM)
#else
#include        "zcdim.F"                    !" 格子点数, 波数
#endif
*
      REAL       WTVOR ( NMDIM, KMAX      )  !" 渦度  ζ 時間変化
      REAL       WTDIV ( NMDIM, KMAX      )  !" 発散  Ｄ 時間変化
      REAL       WTPHI ( NMDIM, KMAX      )  !" 層厚  φ 時間変化
*
      REAL       GTUA  ( IDIM, JDIM, KMAX )  !" 東西運動量移流項ＵＡ
      REAL       GTVA  ( IDIM, JDIM, KMAX )  !" 南北運動量移流項ＶＡ
      REAL       GTKE  ( IDIM, JDIM, KMAX )  !" 運動エネルギー項ＫＥ
      REAL       GTUP  ( IDIM, JDIM, KMAX )  !" 層厚東西移流項  Ｕφ
      REAL       GTVP  ( IDIM, JDIM, KMAX )  !" 層厚南北移流項  Ｖφ
      REAL       GTH   ( IDIM, JDIM, KMAX )  !" 温度時間変化項  Ｈ
*
      REAL       FLAPLA( NMDIM )             !" ラプラシアンの係数
*
      COMMON    /COMWRK/
     &           WTKE
      REAL       WTKE  ( NMDIM     , KMAX )  !" 運動エネルギー項 ＫＥ
*
      INTEGER    K, NM
*
*"          < 1.  渦度 ζ  >
*
*
*"       ( - ∂(ＵＡ)/∂ｙ )
*
      CALL G2W
     O         ( WTVOR ,
     I           GTUA  ,
     I           'YGRA', 'POS ',  KMAX  )
*
*"       (  ∂(ＶＡ)/∂ｘ )
*
      IF ( MMAX .GE. 1 ) THEN
         CALL G2W
     O         ( WTVOR ,
     I           GTVA  ,
     I           'XGRA', 'ADD ', KMAX  )
      ENDIF
*
*"          < 2.  発散 Ｄ  >
*
*"       (  ∂(ＶＡ)/∂ｙ )
*
      CALL G2W
     O         ( WTDIV ,
     I           GTVA  ,
     I           'YGRA', 'NEG ', KMAX )
*
*"       (  ∂(ＵＡ)/∂ｘ )
*
      IF ( MMAX .GE. 1 ) THEN
         CALL G2W
     O         ( WTDIV ,
     I           GTUA  ,
     I           'XGRA', 'ADD ', KMAX )
      ENDIF
*
*"       ( ＫＥ )
*
      CALL G2W
     O         ( WTKE  ,
     I           GTKE  ,
     I           '    ', 'POSO', KMAX )
*
      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 G2W
     O         ( WTPHI ,
     I           GTVP  ,
     I           'YGRD', 'POS ', KMAX )
*
*"       ( - ∂(Ｕφ')/∂ｘ )
*
      IF ( MMAX .GE. 1 ) THEN
         CALL G2W
     O         ( WTPHI ,
     I           GTUP  ,
     I           'XGRD', 'SUB ', KMAX )
      ENDIF
*
*"       ( Ｈ )
*
      CALL G2W
     O         ( WTPHI ,
     I           GTH   ,
     I           '    ', 'ADDO', KMAX )
*
      RETURN
      END
***********************************************************************
*"             << 予報変数 ( スペクトル化 ) >>
***********************************************************************
      SUBROUTINE GD2WD
     O         ( WDVOR , WDDIV , WDPHI ,
     I           GDVOR , GDDIV , GDPHI   )
*
#if   SYS_IBMS
      INCLUDE   (ZCDIM)
#else
#include        "zcdim.F"
#endif
*
      REAL       WDVOR ( NMDIM , KMAX     )  !" 渦度  ζ
      REAL       WDDIV ( NMDIM , KMAX     )  !" 発散  Ｄ
      REAL       WDPHI ( NMDIM , KMAX     )  !" 層厚  φ
*
      REAL       GDVOR ( IDIM*JDIM, KMAX )   !" 渦度  ζ
      REAL       GDDIV ( IDIM*JDIM, KMAX )   !" 発散  Ｄ
      REAL       GDPHI ( IDIM*JDIM, KMAX )   !" 層厚  φ
*
*"          < 1. 予報変数 ζ,Ｄ,φ の変換 >
*
      CALL G2W
     O         ( WDVOR ,
     I           GDVOR ,
     I           '    ', 'POS ', KMAX )
*
      CALL G2W
     O         ( WDDIV ,
     I           GDDIV ,
     I           '    ', 'POS ', KMAX )
*
      CALL G2W
     O         ( WDPHI ,
     I           GDPHI ,
     I           '    ', 'POSO', KMAX )
*
      RETURN
      END
***********************************************************************
*"        << （Ｕ,Ｖ）格子点 → （ζ,Ｄ） スペクトル >>
***********************************************************************
      SUBROUTINE GUV2VD
     O         ( WDVOR , WDDIV ,
     I           GDU   , GDV   ,
     C           UVFACT         )
*
#if   SYS_IBMS
      INCLUDE   (ZCDIM)
#else
#include        "zcdim.F"
#endif
*
      REAL       WDVOR ( NMDIM , KMAX     )  !" 渦度  ζ
      REAL       WDDIV ( NMDIM , KMAX     )  !" 発散  Ｄ
*
      REAL       GDU   ( IDIM*JDIM, KMAX )   !" 西風  ｕ
      REAL       GDV   ( IDIM*JDIM, KMAX )   !" 南風  ｖ
      REAL       UVFACT( IDIM*JDIM )         !" u→U のファクター
*
      COMMON    /COMWRK/
     &           GDUU  , GDVV
      REAL       GDUU  ( IDIM*JDIM, KMAX )   !" 西風  Ｕ
      REAL       GDVV  ( IDIM*JDIM, KMAX )   !" 南風  Ｖ
*
      INTEGER    K, IJ
*
*"          < 1. ζ のスペクトル >
*
      DO 1100 K = 1, KMAX
         DO 1100 IJ = 1, IDIM*JDIM
            GDUU ( IJ, K ) = GDU ( IJ, K ) * UVFACT( IJ )
            GDVV ( IJ, K ) = GDV ( IJ, K ) * UVFACT( IJ )
 1100 CONTINUE
*
      IF ( LMAX .GE. 1 ) THEN
         CALL G2W
     O         ( WDVOR ,
     I           GDUU  ,
     I           'YGRA', 'POS ', KMAX )
      ELSE
         CALL RESET ( WDVOR, NMDIM*KMAX )
      ENDIF
*
      IF ( MMAX .GE. 1 ) THEN
         CALL G2W
     O         ( WDVOR ,
     I           GDVV  ,
     I           'XGRA', 'ADD ', KMAX )
      ENDIF
*
*"         < 2. Ｄ のスペクトル >
*
      IF ( LMAX .GE. 1 ) THEN
         CALL G2W
     O         ( WDDIV ,
     I           GDVV  ,
     F           'YGRA', 'NEG ', KMAX )
      ELSE
         CALL RESET ( WDDIV, NMDIM*KMAX )
      ENDIF
*
      IF ( MMAX .GE. 1 ) THEN
         CALL G2W
     O         ( WDDIV ,
     I           GDUU  ,
     F           'XGRA', 'ADD ', KMAX )
      ENDIF
*
      RETURN
      END