*"表題   BARO 力学 メインパート GCM5(BDADMN)
*
*"履歴   90/08/31 沼口  敦
*       92/04/02 竹広真一
*
*
**********************************************************************
*"        << 力学過程 ( スペクトル ) >>
**********************************************************************
      SUBROUTINE DYNMCS
     M         ( GAU   , GAV   ,
     M           GBU   , GBV   ,
     M           GAVOR , GBVOR ,
     M           GTUA  , GTVA  ,
     I           IT    , DELT  , OADVNC,
     C           ALON  , DLON  , ALAT  , DLAT  )
*
#if   HITAC
      INCLUDE   (ZCDIM)                  !" 格子点数, 波数
      INCLUDE   (ZCCOM)                  !" 文字列文字数
#elif SX3
      INCLUDE   "zcdim.F"                    !" 格子点数, 波数
      INCLUDE   "zccom.F"                    !" 文字列文字数
#else
#include        "zcdim.F"                    !" 格子点数, 波数
#include        "zccom.F"                    !" 文字列文字数
#endif
*
*"     ========== 変数 =========================================
*
*"     ------- 格子点データ ------------------------------------
*
      REAL       GAU   ( IDIM, JDIM, KMAX )  !" 西風  ｕ(t)
      REAL       GBU   ( IDIM, JDIM, KMAX )  !" 西風  ｕ(t-Δt)
      REAL       GAV   ( IDIM, JDIM, KMAX )  !" 南風  ｖ(t)
      REAL       GBV   ( IDIM, JDIM, KMAX )  !" 南風  ｖ(t-Δt)
      REAL       GAVOR ( IDIM, JDIM, KMAX )  !" 渦度  ζ(t)
      REAL       GBVOR ( IDIM, JDIM, KMAX )  !" 渦度  ζ(t-Δt)
*
*"     ------- 格子点時間変化項 -------------------------------------
*
      REAL       GTUA  ( IDIM, JDIM, KMAX )  !" 東西運動量移流項ＵＡ
      REAL       GTVA  ( IDIM, JDIM, KMAX )  !" 南北運動量移流項ＶＡ
*
*"     ------- 時刻変数 ---------------------------------------------
*
      INTEGER    IT                          !" 通し時間
      REAL       DELT                        !" 時間刻みΔt
      LOGICAL    OADVNC                      !" 時刻が進行するか否か
*
*"     ========= 定数 ==========================================
*
*"     ------ 座標格子定数 -------------------------------------
*
      REAL       ALON  ( IDIM )              !" 経度
      REAL       DLON  ( IDIM )              !" 経度荷重
      REAL       ALAT  ( JDIM )              !" 緯度
      REAL       DLAT  ( JDIM )              !" 緯度荷重
*
*"     ==========  内部変数 ====================================
*
*"     ------- スペクトルデータ --------------------------------
*
      REAL       WDVOR ( NMDIM , KMAX     )  !" 渦度  ζ
*
*"     ------- スペクトル時間変化項 ----------------------------
*
      REAL       WTVOR ( NMDIM, KMAX      )  !" 渦度  ζ
*
*"     ======= 内部定数(DSETCで確定) ============================
*
*"     ------ 球関数展開定数 -----------------------------------
*
      INTEGER    NMO   ( 2, 0:MMAX, 0:LMAX ) !" スペクトルの添字順番
      REAL       FLAPLA( NMDIM  )            !" ラプラシアンの係数
      REAL       EDEL  ( NMDIM  )            !" ζ，Ｄ→Ｕ，Ｖ
*
*"     ------ 力学定数 -----------------------------------------
*
      REAL       CORIOL ( IDIM, JDIM )       !" コリオリ係数 ｆ
      REAL       UVFACT ( IDIM, JDIM )       !" u→U のファクター
*
*"     ------ 時間積分定数 -------------------------------------
*
      REAL       DIFV  ( NMDIM  )            !" 運動量水平拡散係数
      REAL       DIFT  ( NMDIM  )            !" 熱，水水平拡散係数
*
      SAVE       NMO   , FLAPRA, EDEL  ,
     &           CORIOL, UVFACT, DIFV  , DIFT
*
      LOGICAL    ODIASP                      !" 診断出力するか否か
      DATA       ODIASP         / .FALSE. /
      SAVE       ODIASP
*
      LOGICAL    OSETC 
      DATA       OSETC  / .FALSE. /
      SAVE       OSETC 
*
*
*"          < 0. 定数のセット >
*
      IF ( .NOT. OSETC ) THEN
         OSETC = .TRUE.
         CALL    DSETC
     O         ( NMO   , FLAPLA, EDEL  ,
     O           CORIOL, UVFACT, DIFV  , DIFT  ,
     C           ALAT  , DLAT                   )
      ENDIF
*
*"          < 1. 非線型力学項 >
*
      CALL GRDDYN
     M         ( GTUA  , GTVA  ,
     I           GAU   , GAV   ,
     I           GAVOR ,
     C           CORIOL, UVFACT  )
*
*"          < 2. 時間変化項 ( スペクトル ) >
*
      CALL TENG2W
     O         ( WTVOR ,
     I           GTUA  , GTVA )
*
*"          < 3. 予報変数 ( スペクトル ) >
*
      CALL GD2WD
     O         ( WDVOR ,
     I           GBVOR   )
*
*"          < 5. 時間積分 ( スペクトル ) >
*
      CALL TINTGR
     M         ( WDVOR ,
     I           WTVOR ,
     I           DELT  ,
     C           DIFV  , FLAPLA )
*
      DO 5100 K = 1, KMAX
         WDVOR( NMO(1,0,0),K ) = 0.
 5100 CONTINUE
*
*"          < 7. 新格子点値の生成 >
*
      IF ( OADVNC ) THEN
         CALL MOVGD
     O         ( GBU   , GBV   ,
     O           GBVOR ,
     I           GAU   , GAV   ,
     I           GAVOR           )
      ENDIF
*
      CALL GENGD
     O         ( GAU   , GAV   ,
     O           GAVOR ,
     I           WDVOR ,
     C           EDEL  , UVFACT          )
*
*"          < 10. 診断出力 >
*
*
C     CALL IPGET( 'ODIAG', ODIAG )
C     IF ( ODIAG ) THEN
C        CALL  DDIAG
C     ENDIF
*
      RETURN
*======================================================================
*"        << 初期データの再生成 >>
*======================================================================
      ENTRY DSTRT
     M         ( GAU   , GAV   ,
     M           GBU   , GBV   ,
     O           GAVOR , GBVOR ,
     C           ALAT  , DLAT     )
*
      IF ( .NOT. OSETC ) THEN
         OSETC = .TRUE.
         CALL    DSETC
     O         ( NMO   , FLAPLA, EDEL  ,
     O           CORIOL, UVFACT, DIFV  , DIFT  ,
     C           ALAT  , DLAT                     )
      ENDIF
*
*"          < 1. t-Δt のデータの再生成 >
*
      CALL STRTV
     M         ( GBU   , GBV   ,
     O           GBVOR ,
     C           EDEL  , UVFACT,
     W           WDVOR                   )
*
*"          < 2. t のデータの再生成 >
*
      CALL STRTV
     M         ( GAU   , GAV   ,
     O           GAVOR ,
     C           EDEL  , UVFACT,
     W           WDVOR                  )
*
      RETURN
      END
