*"表題   SHALO 共通 メイン GCM5(SAADMN)
*
*"履歴   90/08/31 沼口  敦
*"       92/06/11 竹広真一
*"       93/11/02 林 祥介   ディレクトリ整理
*"       96/11/13 竹広真一
*
***********************************************************************
      PROGRAM SHALO5
*
*
*"        << 発散バロトロピック全球モデル >>
*
*"                  Version 0.50              90/08/31 ( 沼口 敦 )
*"                          1.00              96/11/13 ( 竹広真一 )
*
*            semi implicit scheme
*
*======================================================================
*
*
#if   SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数, 波数
      INCLUDE   (ZCCOM)                      !" 標準物理定数
#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       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    ISTEP                       !" 通しステップ数
      INTEGER    ITA                         !" 通し時間(t)
      INTEGER    ITB                         !" 通し時間(t-Δt)
      INTEGER    IDATEA( 6 )                 !" 時刻：年月日時分秒
      INTEGER    IDATEB( 6 )                 !" 時刻：年月日時分秒
      REAL       DELT                        !" 時間刻みΔt
      LOGICAL    OADVNC                      !" 時刻が進行するか否か
      LOGICAL    ORSTR                       !" 再出発出力するか否か
*
*"     ========= 外部パラメーター ==============================
*
*"     ------ 物理パラメーター ---------------------------------
*
*     COMMON /COMCON/ ( include ZCCOM )
*     REAL       ER                          !" 地球半径
*     REAL       GRAV                        !" 重力加速度
*     COMMON /COMCON/ end
*
*"     ------ モデルパラメーター -------------------------------
*
      INTEGER    IDELT                       !" 標準時間刻み
      INTEGER    INISTP                      !" 初期ステップ数
*
*"     ------ 実験管理パラメーター -----------------------------
*
      INTEGER    IORSTR                      !" 出力間隔：再出発
      INTEGER    ITSTRT                      !" 計算開始時刻：通し秒
      INTEGER    ITEND                       !" 計算終了時刻：通し秒
*
*"     ========= 内部定数 ======================================
*
*"     ------ 座標格子定数 -------------------------------------
*
      REAL       ALAT  ( JDIM )              !" 緯度
      REAL       DLAT  ( JDIM )              !" 緯度荷重
      REAL       ALON  ( IDIM )              !" 経度
      REAL       DLON  ( IDIM )              !" 経度荷重
*
*"     ========= ワーク ========================================
*
      COMMON    /COMWRK/ WORK
      REAL       WORK  ( NWORK )             !" ワーク領域
*
      CALL CLCSTR ( 'SETUP' )
      CALL YPREP                       !" システム前処理 
*
*"          <************* 初期設定 ***************>
*
*
*"          < 1. 実験パラメーターのセット >
*
      CALL SETPAR
     O         ( ITSTRT, ITEND , IORSTR,
     O           IDELT , INISTP          )
*
*"          < 2. モデル座標定数の計算 >
*
      CALL PCONST
*
      CALL ACRGET
     O         ( ALON  , DLON  ,
     O           ALAT  , DLAT    )
*
*"          < 3. 初期値の読み込みと生成 >
*
*"             < 3.1 ファイルからの読み込み >
*
      CALL IRSTRT
     O         ( GAU   , GAV   , GAPHI ,
     O           GBU   , GBV   , GBPHI ,
     O           ITA   , ITB   , IDATEA, IDATEB, ISTEP ,
     C           ITSTRT  )
*
*"             < 3.2 波数展開後再生成 >
*
      CALL DSTRT
     M         ( GAU   , GAV   , GAPHI ,
     M           GBU   , GBV   , GBPHI ,
     O           GAVOR , GADIV , 
     O           GBVOR , GBDIV   )
*
*"          < 4. 出力セットアップ >
*
      CALL SETTIM ( ITA   , ITB   , IDATEA, IDATEB, ISTEP  )
*
      CALL IHSTRT
      CALL IHSTRG
*
      CALL CLCEND ( 'SETUP' )
*
 5000 CONTINUE
*                                             <===== repeat MAIN ===
*
*"          <*********** メイン・ループ始まり ************>
*
         ISTEP = ISTEP + 1
*
*"          < 5. 時間制御 >
*
         CALL CLCSTR ( 'TIMCON' )
*
         CALL TIMSTP
     O         ( DELT  , OADVNC, ORSTR ,
     I           ITA   , ITB   , IDATEA, IDATEB, ISTEP  ,
     C           IDELT , INISTP, ITEND , IORSTR          )
*
*"                 < 5.2  (t-Δt)のデータをセーブ >
*
         CALL SAVEGB
     I         ( GBU   , GBV   , GBPHI ,
     I           GBVOR , GBDIV           )
*
         CALL CLCEND ( 'TIMCON' )
*
*"          < 6. 力学過程/時間積分 >
*
         CALL CLCSTR ( 'DYNMCS' )
*
         CALL RESET ( GTUA, IDIM*JDIM*KDIM )
         CALL RESET ( GTVA, IDIM*JDIM*KDIM )
         CALL RESET ( GTH , IDIM*JDIM*KDIM )
*
         CALL DYNMCS
     M         ( GAU   , GAV   , GAPHI ,
     M           GBU   , GBV   , GBPHI ,
     M           GAVOR , GADIV , GBVOR , GBDIV ,
     M           GTUA  , GTVA  , GTH   ,
     I           ITB   , DELT  , OADVNC )
*
         CALL CLCEND ( 'DYNMCS' )
*
*"          <  8. 時間積分後処理 >
*
*"                 < 8.3 タイムフィルター  >
*
         CALL CLCSTR ( 'TFILT' )
*
         IF ( OADVNC ) THEN
            CALL TFILT
     M         ( GBU   , GBV   , GBPHI ,
     M           GBVOR , GBDIV ,
     I           GAU   , GAV   , GAPHI ,
     I           GAVOR , GADIV  )
         ENDIF
*
         CALL CLCEND ( 'TFILT' )
*
*"         <  9. ヒストリー出力 >
*
         IF ( OADVNC ) THEN
*
*"            < 9.1 平均領域に足し込む >
*
            CALL CLCSTR ( 'HISTIN' )
            CALL HISTIN ( GBU   , 'U'     )
            CALL HISTIN ( GBV   , 'V'     )
            CALL HISTIN ( GBPHI , 'PHI'   )
            CALL HISTIN ( GBVOR , 'VOR'   )
            CALL HISTIN ( GBDIV , 'DIV'   )
            CALL HISTIN ( GTUA  , 'UA'   )
            CALL HISTIN ( GTVA  , 'VA'   )
            CALL HISTIN ( GTH   , 'TH'   )
            CALL CLCEND ( 'HISTIN' )
*
*"            < 9.2 平均して出力 >
*
            CALL CLCSTR ( 'HISTOU' )
            CALL HISTRP
            CALL HISTOU
            CALL CLCEND ( 'HISTOU' )
*
         ENDIF
*
*"         < 10. 時刻変更  >
*
         CALL CLCSTR ( 'MISC' )
*
         CALL    ADVSTP
     O         ( ITA   , ITB   , IDATEA, IDATEB,
     I           OADVNC                        )
*
*"         < 11. リスタート・ファイルの書き込み >
*
         IF ( ORSTR ) THEN 
            CALL IWRSTR
     I         ( GAU   , GAV   , GAPHI ,
     I           GBU   , GBV   , GBPHI ,
     I           ITA   , ITB   , IDATEA, IDATEB, ISTEP )
         ENDIF
*
         CALL CLCEND ( 'MISC' )
*
*"          <********** メイン・ループ終わり *************>
*
*                                              ======> until MAIN ===
      IF ( .NOT. ( ITB .GE. ITEND )  ) GOTO  5000
*
      CALL CLCOUT
*
      STOP
      END
