*表題   BARO 共通 メイン BARO(BAADMN)
*
*"履歴   90/08/31 沼口  敦
*"       92/06/08 竹広真一  強制項の導入
*"       93/11/02 林 祥介   ディレクトリ整理
*"       96/09/14 竹広真一
*"       96/11/13 竹広真一 SETPAR 修正, TFIL 消去
*
***********************************************************************
      PROGRAM BARO
*
*"        << 非発散バロトロピック全球モデル >>
*
*"                  Version 0.50              90/08/31 ( 沼口 敦 )
*"                          1.00              92/03/31 ( 竹広真一 )
*
*======================================================================
*
*
#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       GAVOR ( IDIM, JDIM, KMAX )  !" 渦度  ζ(t)
      REAL       GBVOR ( IDIM, JDIM, KMAX )  !" 渦度  ζ(t-Δt)
*
*"     ------- 格子点時間変化項 --------------------------------
*
      REAL       GTUA  ( IDIM, JDIM, KMAX )  !" 東西運動量変化項ＵＡ
      REAL       GTVA  ( 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                          !" 地球半径
*     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   , GAVOR , 
     O           GBU   , GBV   , GBVOR , 
     O           ITA   , ITB   , IDATEA, IDATEB, ISTEP, 
     I           ITSTRT )
*
*"             < 3.2 波数展開後再生成 >
*
      CALL DSTRT
     M         ( GAU   , GAV   ,
     M           GBU   , GBV   ,
     O           GAVOR , GBVOR   )
*
*"          < 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   ,
     I           GBVOR           )
*
         CALL CLCEND ( 'TIMCON' )
*
*"          < 6. 力学過程/時間積分 >
*
         CALL CLCSTR ( 'DYNMCS' )
*
         CALL RESET( GTUA, IDIM*JDIM*KMAX )
         CALL RESET( GTVA, IDIM*JDIM*KMAX )
*
         CALL DYNMCS
     M         ( GAU   , GAV   ,
     M           GBU   , GBV   ,
     M           GAVOR , GBVOR ,
     M           GTUA  , GTVA  ,
     I           ITB   , DELT  , OADVNC )
*
         CALL CLCEND ( 'DYNMCS' )
*
*"          <  8. 調節 >
*
*"                 < 8.2 タイムフィルター  >
*
         CALL CLCSTR ( 'TFILT' )
*
         IF ( OADVNC ) THEN
            CALL TFILT
     M         ( GBU   , GBV   ,
     M           GBVOR ,
     I           GAU   , GAV   ,
     I           GAVOR  )
         ENDIF
*
         CALL CLCEND ( 'TFILT' )
*
*"          <  9. ヒストリー・ファイル出力 >
*
         IF ( OADVNC ) THEN
*
*"             < 9.1 平均領域に足し込む >
*
            CALL CLCSTR ( 'HISTIN' )
            CALL HISTIN ( GBU   , 'U'     )
            CALL HISTIN ( GBV   , 'V'     )
            CALL HISTIN ( GBVOR , 'VOR'   )
            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   , GAVOR ,
     I           GBU   , GBV   , GBVOR ,
     I           ITA   , ITB   , IDATEA, IDATEB, ISTEP )
         ENDIF
*
         CALL CLCEND ( 'MISC' )
*
*"          <********** メイン・ループ終わり *************>
*
*                                              ======> until MAIN ===
      IF ( .NOT. ( ITB .GE. ITEND )  ) GOTO  5000
*
      CALL IHEND
      CALL CLCOUT
*
      STOP
      END
