*"表題   BARO 力学 格子→スペクトル GCM5(BDG2WD)
*
*"履歴   90/08/31 沼口  敦
*"       92/02/19 竹広真一
*"       96/08/23 竹広真一
*"       96/11/15 竹広真一
*
**********************************************************************
*"            << 時間変化項 ( スペクトル化 ) >>
**********************************************************************
      SUBROUTINE TENG2W
     O         ( WTVOR ,
     I           GTUA  , GTVA   )
*
*                  << semi implicit scheme >>
*
#if   SYS_IBMS
      INCLUDE   (ZCDIM)                  !" 格子点数, 波数
#else
#include        "zcdim.F"                    !" 格子点数, 波数
#endif
*
      REAL       WTVOR ( NMDIM, KMAX      )  !" 渦度  ζ 時間変化
*
      REAL       GTUA  ( IDIM, JDIM, KMAX )  !" 東西運動量移流項ＵＡ
      REAL       GTVA  ( IDIM, JDIM, KMAX )  !" 南北運動量移流項ＶＡ
*
*"          < 1.  渦度 ζ  >
*
*
*"       ( - ∂(ＵＡ)/∂ｙ )
*
      IF ( LMAX .GE. 1 ) THEN
         CALL G2W
     O         ( WTVOR ,
     I           GTUA  ,
     I           'YGRA', 'POS ',  KMAX  )
      ELSE
         CALL RESET ( WTVOR, NMDIM*KMAX )
      ENDIF
*
*"       (  ∂(ＶＡ)/∂ｘ )
*
      IF ( MMAX .GE. 1 ) THEN
         CALL G2W
     O         ( WTVOR ,
     I           GTVA  ,
     I           'XGRA', 'ADD ', KMAX  )
      ENDIF
*
      RETURN
      END
***********************************************************************
*"             << 予報変数 ( スペクトル化 ) >>
***********************************************************************
      SUBROUTINE GD2WD
     O         ( WDVOR ,
     I           GDVOR  )
*
#if   SYS_IBMS
      INCLUDE   (ZCDIM)
#else
#include        "zcdim.F"
#endif
*
      REAL       WDVOR ( NMDIM , KMAX     )  !" 渦度  ζ
*
      REAL       GDVOR ( IDIM*JDIM, KMAX )   !" 渦度  ζ
*
*"          < 1. 予報変数 ζ,Ｄ,Ｔ, π,ｑ の変換 >
*
      CALL G2W
     O         ( WDVOR ,
     I           GDVOR ,
     I           '    ', 'POS ', KMAX )
*
      RETURN
      END
***********************************************************************
*"        << （Ｕ,Ｖ）格子点 → （ζ,Ｄ） スペクトル >>
***********************************************************************
      SUBROUTINE GUV2VD
     O         ( WDVOR ,
     I           GDU   , GDV   ,
     C           UVFACT         )
*
#if   SYS_IBMS
      INCLUDE   (ZCDIM)
#else
#include        "zcdim.F"
#endif
*
      REAL       WDVOR ( 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
*
      RETURN
      END
