*"表題   SHALO 力学 メインパート GCM5(SDADMN)
*
*"履歴   90/08/31 沼口  敦
*"       92/06/11 竹広真一
*"       96/11/13 竹広真一
*
**********************************************************************
*"        << 力学過程 ( スペクトル ) >>
**********************************************************************
      SUBROUTINE DYNMCS
     M         ( GAU   , GAV   , GAPHI ,
     M           GBU   , GBV   , GBPHI ,
     M           GAVOR , GADIV , GBVOR , GBDIV ,
     M           GTUA  , GTVA  , GTH   ,
     I           IT    , DELT  , OADVNC )
*
*
#if   SYS_IBMS
      INCLUDE   (ZCDIM)                  !" 格子点数, 波数
#else
#include        "zcdim.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       GAPHI ( IDIM, JDIM, KMAX )  !" 層厚  φ(t)
      REAL       GBPHI ( IDIM, JDIM, KMAX )  !" 層厚  φ(t-Δt)
      REAL       GAVOR ( IDIM, JDIM, KMAX )  !" 渦度  ζ(t)
      REAL       GBVOR ( IDIM, JDIM, KMAX )  !" 渦度  ζ(t-Δt)
      REAL       GADIV ( IDIM, JDIM, KMAX )  !" 発散  Ｄ(t)
      REAL       GBDIV ( IDIM, JDIM, KMAX )  !" 発散  Ｄ(t-Δt)
*
*"     ------- 格子点時間変化項 -------------------------------------
*
      REAL       GTUA  ( IDIM, JDIM, KMAX )  !" 東西運動量移流項ＵＡ
      REAL       GTVA  ( IDIM, JDIM, KMAX )  !" 南北運動量移流項ＶＡ
      REAL       GTH   ( IDIM, JDIM, KMAX )  !" 温度時間変化項  Ｈ
*
*"     ------- 時刻変数 ---------------------------------------------
*
      INTEGER    IT                          !" 通し時間
      REAL       DELT                        !" 時間刻みΔt
      LOGICAL    OADVNC                      !" 時刻が進行するか否か
*
*"     ==========  内部変数 ====================================
*
*"     ------ 格子点時間変化項 ---------------------------------
*
      REAL       GTKE  ( IDIM, JDIM, KMAX )  !" 運動エネルギー項ＫＥ
      REAL       GTUP  ( IDIM, JDIM, KMAX )  !" 層厚東西移流項  Ｕφ
      REAL       GTVP  ( IDIM, JDIM, KMAX )  !" 層厚南北移流項  Ｖφ
*
*"     ------- スペクトルデータ --------------------------------
*
      REAL       WDVOR ( NMDIM , KMAX     )  !" 渦度  ζ
      REAL       WDDIV ( NMDIM , KMAX     )  !" 発散  Ｄ
      REAL       WDPHI ( NMDIM , KMAX     )  !" 層厚  φ
*
*"     ------- スペクトル時間変化項 ----------------------------
*
      REAL       WTVOR ( NMDIM, KMAX      )  !" 渦度  ζ
      REAL       WTDIV ( NMDIM, KMAX      )  !" 発散  Ｄ
      REAL       WTPHI ( NMDIM , KMAX     )  !" 層厚  φ
*
*"     ======= 内部定数(DSETUPで確定) ==========================
*
*"     ------ 球関数展開定数 -----------------------------------
*
      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  )            !" 熱，水水平拡散係数
*
*"     ------ 境界条件 -----------------------------------------
*
      REAL       WPHIS ( NMDIM )             !" 地表ジオポテンシャル
*
      SAVE       NMO   , FLAPRA, EDEL  ,
     &           CORIOL, UVFACT, DIFV  , DIFT  ,
     &           WPHIS
*
      REAL       PHIBAR ( KMAX )             !" 平均層厚
      SAVE       PHIBAR
*
      LOGICAL    ODIASP
      DATA       ODIASP         / .FALSE. /
      SAVE       ODIASP
*
      LOGICAL    OSETC
      DATA       OSETC / .FALSE. /
      SAVE       OSETC
*
      INTEGER    I, J, K
*
*
*"          < 0. 定数のセット >
*
      IF ( .NOT. OSETC ) THEN
         OSETC = .TRUE.
         CALL    DCSET
     O         ( NMO   , FLAPLA, EDEL  ,
     O           CORIOL, UVFACT, DIFV  , DIFT )
      ENDIF
*
      CALL DPHIS
     O         ( WPHIS ,
     I           IT      )
*
*"          < 1. 非線型力学項 >
*
      CALL GRDDYN
     M         ( GTUA  , GTVA  , GTH   ,
     O           GTKE  , GTUP  , GTVP  ,
     I           GAU   , GAV   , GAPHI ,
     I           GAVOR , GADIV ,
     C           CORIOL, UVFACT, PHIBAR  )
*
*"          < 2. 時間変化項 ( スペクトル ) >
*
      CALL TENG2W
     O         ( WTVOR , WTDIV , WTPHI ,
     I           GTUA  , GTVA  , GTKE  , GTUP  , GTVP  , GTH   ,
     C           FLAPLA                                          )
*
*"          < 3. 予報変数 ( スペクトル ) >
*
      CALL GD2WD
     O         ( WDVOR , WDDIV , WDPHI ,
     I           GBVOR , GBDIV , GBPHI  )
*
*"          < 5. 時間積分 ( スペクトル ) >
*
      CALL TINTGR
     M         ( WDVOR , WDDIV , WDPHI ,
     I           WTVOR , WTDIV , WTPHI ,
     I           DELT  ,
     C           DIFV  , DIFT  , FLAPLA, WPHIS , PHIBAR  )
*
*"          < 7. 新格子点値の生成 >
*
      IF ( OADVNC ) THEN
         CALL MOVGD
     O         ( GBU   , GBV   , GBPHI ,
     O           GBVOR , GBDIV ,
     I           GAU   , GAV   , GAPHI ,
     I           GAVOR , GADIV          )
      ENDIF
*
      CALL GENGD
     O         ( GAU   , GAV   , GAPHI ,
     O           GAVOR , GADIV ,
     I           WDVOR , WDDIV , WDPHI ,
     C           EDEL  , UVFACT         )
*
*
*"         < 9. ヒストリーデータ入力 >
*
c$$$          CALL HISTIN ( GTKE   , 'KE'   )
          CALL HISTIN ( GTUP   , 'UP'   )
          CALL HISTIN ( GTVP   , 'VP'   )
*
      CALL DDIAG
     I         ( GAU   , GAV   , GAPHI  , 
     I           GAVOR , GADIV , 
     C           PHIBAR   )
*
      RETURN
*======================================================================
*"        << 初期データの再生成 >>
*======================================================================
      ENTRY DSTRT
     M         ( GAU   , GAV   , GAPHI ,
     M           GBU   , GBV   , GBPHI ,
     O           GAVOR , GADIV , 
     O           GBVOR , GBDIV  )
*
      IF ( .NOT. OSETC ) THEN
         OSETC = .TRUE.
         CALL    DCSET
     O         ( NMO   , FLAPLA, EDEL  ,
     O           CORIOL, UVFACT, DIFV  , DIFT  )
      ENDIF
*
*"          < 11. t-Δt のデータの再生成 >
*
      CALL STRTV
     M         ( GBU   , GBV   , GBPHI ,
     O           GBVOR , GBDIV ,
     C           EDEL  , UVFACT,
     W           WDVOR , WDDIV , WDPHI   )
*
*"          < 12. t のデータの再生成 >
*
      CALL STRTV
     M         ( GAU   , GAV   , GAPHI ,
     O           GAVOR , GADIV ,
     C           EDEL  , UVFACT,
     W           WDVOR , WDDIV , WDPHI   )
*
*"          < 13. 平均層厚の計算 >
*
      DO 9100 K = 1, KMAX
         PHIBAR ( K ) = 0.
*
         DO 9110 I = 1, IMAX
            DO 9110 J = 1, JMAX
               PHIBAR ( K ) = PHIBAR( K ) + GBPHI( I,J,K )
 9110    CONTINUE
*
         PHIBAR( K ) = PHIBAR( K ) / REAL( IMAX*JMAX )
 9100 CONTINUE
*
      RETURN
      END
