*表題   BARO 共通 メイン BARO(BAADMN)
*
*"履歴   90/08/31 沼口  敦
*"       92/06/08 竹広真一  強制項の導入
*"       93/11/02 林 祥介   ディレクトリ整理
*
***********************************************************************
      PROGRAM BARO
*
*
*"        << 非発散バロトロピック全球モデル >>
*
*"                  Version 0.50              90/08/31 ( 沼口 敦 )
*"                          1.00              92/03/31 ( 竹広真一 )
*
*======================================================================
*
*"   使用するメンバー
*
*"     APARM  , ASETL  , ASETS  , ASTEP  , APCON  , ATIME
*"     BASETC , BASAVB , BASTRT , BATFIL , BDADMN , BDSTRT
*"     [BDGDYN|BDGDYN0], BDGENG , BDINTG , BDG2WD
*"     DSETC  , DSPHE  ,
*"     IAVRG  , ICORD  , IFOPN  , IHDEF  , IHEAD  , IHIST 
*"     IHSUB  , IMONI  , IPRIN  , IRWGD
*"     UFFTR  , UFILE  , UMTLU  , UPARM  , USPHE  , USPST  ,
*"     USUBF  , USUBS  ,
*"     YHITAC                           ( system dependent )
*"     ZCCOM  , ZCDIM  , ZHDIM  , ZIDIM          ( include )
*"     ( GTOOL3 )
*
*======================================================================
*
*
#if   HITAC
      INCLUDE   (ZCDIM)                  !" 格子点数, 波数
      INCLUDE   (ZHDIM)                  !" 文字列文字数
      INCLUDE   (ZCCOM)                  !" 標準物理定数
#elif SX3
      INCLUDE   "zcdim.F"                    !" 格子点数, 波数
      INCLUDE   "zhdim.F"                    !" 文字列文字数
      INCLUDE   "zccom.F"                    !" 標準物理定数
#else
#include        "zcdim.F"                    !" 格子点数, 波数
#include        "zhdim.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       CP                          !" 大気定圧比熱
*      REAL       EL                          !" 水の凝結の潜熱
*      REAL       ER                          !" 地球半径
*      REAL       GRAV                        !" 重力加速度
*      REAL       RAIR                        !" 大気気体定数
*      REAL       RVAP                        !" 水蒸気気体定数
*      REAL       CPVAP                       !" 水蒸気定圧比熱
*      REAL       DH2O                        !" 水の密度
*      REAL       EPSV                        !" 水と大気の分子量比
*      REAL       ES0                         !" ０℃飽和蒸気圧
*      REAL       STB                         !" Stefan-Boltzman
*     COMMON /COMCON/ end
*
*"     ------ モデルパラメーター -------------------------------
*
      INTEGER    IDELT                       !" 標準時間刻み
      INTEGER    INISTP                      !" 初期ステップ数
      REAL       TFIL                        !" 時間フィルター係数
*
*"     ------ 実験管理パラメーター -----------------------------
*
      CHARACTER  HFLSTR *(NFILN)             !" 入力ファイル：初期値
      CHARACTER  HFLRST *(NFILN)             !" 出力ファイル：再出発
      CHARACTER  HFLGST *(NFILN)             !" 入力ファイル：地面
      CHARACTER  HFLGRS *(NFILN)             !" 出力ファイル：地面
      DATA       HFLSTR, HFLRST/ 'test.init', 'test.rst'/
*
      CHARACTER  HDFMT  *(NCC)               !" 出力ファイル精度
      DATA       HDFMT  /'UR4'/
*
      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, TFIL            )
c$$$      CALL SETPAR
c$$$     O         ( ITSTRT, ITEND , IORSTR,
c$$$     O           HFLSTR, HFLRST, HFLGST, HFLGRS,
c$$$     O           IDELT , INISTP, TFIL            )
*
*"          < 2. モデル座標定数の計算 >
*
      CALL SETCOR
     O         ( ALON  , DLON  ,
     O           ALAT  , DLAT    )
*
*"          < 3. 初期値の読み込みと生成 >
*
*"             < 3.1 ファイルからの読み込み >
*
      CALL GRSTRT
     O         ( GAU   , GAV   ,
     O           GBU   , GBV   ,
     O           ITA   , ITB   , IDATEA, IDATEB, ISTEP ,
     C           HFLSTR, ITSTRT                           )
*
*"             < 3.2 波数展開後再生成 >
*
      CALL DSTRT
     M         ( GAU   , GAV   ,
     M           GBU   , GBV   ,
     O           GAVOR , GBVOR ,
     C           ALAT  , DLAT     )
*
*"          < 4. 出力セットアップ >
*
      CALL SETTIM ( ITA   , ITB   , IDATEA, IDATEB, ISTEP  )
      CALL AHSTRG
*
      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 ( 'PHYSCS' )
*
         CALL RESET( GTUA, IDIM*JDIM*KMAX )
         CALL RESET( GTVA, IDIM*JDIM*KMAX )
*
c$$$         CALL PHYSCS
c$$$     O         ( GTUA  , GTVA  ,
c$$$     I           GBU   , GBV   , 
c$$$     I           GBVOR , 
c$$$     I           ITB   , IDATEB, DELT*2. ,
c$$$     C           ALON  , ALAT  )
*
         CALL CLCEND ( 'PHYSCS' )
*
*"          < 7. 力学過程/時間積分 >
*
         CALL CLCSTR ( 'DYNMCS' )
*
         CALL DYNMCS
     M         ( GAU   , GAV   ,
     M           GBU   , GBV   ,
     M           GAVOR , GBVOR ,
     M           GTUA  , GTVA  ,
     I           IT    , DELT  , OADVNC,
     C           ALON  , DLON  , ALAT  , DLAT )
*
         CALL CLCEND ( 'DYNMCS' )
*
*"          <  8. 調節 >
*
*"                 < 8.2 タイムフィルター  >
*
         CALL CLCSTR ( 'TFILT' )
*
         IF ( OADVNC ) THEN
            CALL TFILT
     M         ( GBU   , GBV   ,
     M           GBVOR ,
     I           GAU   , GAV   ,
     I           GAVOR ,
     C           TFIL            )
         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 GWRSTR
     I         ( GAU   , GAV   , GAVOR ,
     I           GBU   , GBV   , GBVOR ,
     I           ITA   , ITB   , IDATEA, IDATEB, ISTEP ,
     C           HFLRST, HDFMT                              )
         ENDIF
*
         CALL CLCEND ( 'MISC' )
*
*"          <********** メイン・ループ終わり *************>
*
*                                              ======> until MAIN ===
      IF ( .NOT. ( ITB .GE. ITEND )  ) GOTO  5000
*
      CALL CLCOUT
*
      STOP
      END
***********************************************************************
*"          << 標準時間平均出力の登録 >>
***********************************************************************
      SUBROUTINE AHSTRG
*
      DATA       ISTYPL / 1 /
*
      CALL GTPGET ( 'MISS' , VMISS )
*
      CALL     HISTRG
     I       ( 'U     ', 'u-velocity          ' ,'m/s   ', 'ALEV',
     I           VMISS , VMISS , 2.5   , 10.   , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(F12.3)' )
*
      CALL     HISTRG
     I       ( 'V     ', 'v-velocity          ' ,'m/s   ', 'ALEV',
     I           VMISS , VMISS , 2.5   , 10.   , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(F12.3)' )
*
      CALL     HISTRG
     I       ( 'VOR   ', 'vorticity           ' ,'1/s   ', 'ALEV',
     I           VMISS , VMISS , 1.E-6 , 5.E-6 , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      RETURN
      END

