*" PACKAGE AADMIN !" 共通 メインルーチン
*"                  ver 1.00                   92/06/11 numaguti
*"                  ver 1.00            93/10/08 石渡正樹
*"                  SRC:=$GC/model/agcm5/src/admin/aadmn.F
*"                  DOC:=$GC/model/agcm5/doc/main.tex
***********************************************************************
      PROGRAM GCM5                           !" メインルーチン
*
*"    湿潤多層全球モデル
*"    Arakawa & Suarez 鉛直差分 σ座標
*"    semi implicit scheme
*"    標準物理過程, 簡略放射
*
*   [PARAM]
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数, 波数
      INCLUDE   (ZHDIM)                      !" 文字列文字数
      INCLUDE   (ZCCOM)                      !" 標準物理定数
#else
#include        "zcdim.F"                    !" 格子点数, 波数
#include        "zhdim.F"                    !" 文字列文字数
#include        "zccom.F"                    !" 標準物理定数
#endif
*
*   [VAR]
      REAL       GAU   ( IDIM, JDIM, KMAX )  !" 西風  ｕ
      REAL       GAV   ( IDIM, JDIM, KMAX )  !" 南風  ｖ
      REAL       GAT   ( IDIM, JDIM, KMAX )  !" 温度  Ｔ
      REAL       GAPS  ( IDIM, JDIM       )  !" 地表気圧
      REAL       GAQ   ( IDIM, JDIM, KMAX )  !" 比湿  ｑ
      REAL       GAVOR ( IDIM, JDIM, KMAX )  !" 渦度  ζ
      REAL       GADIV ( IDIM, JDIM, KMAX )  !" 発散  Ｄ
*"       : 格子点データ(t) <DYNMCS>  格子点データ(t+Δt)
*
      REAL       GBU   ( IDIM, JDIM, KMAX )  !" 西風  ｕ
      REAL       GBV   ( IDIM, JDIM, KMAX )  !" 南風  ｖ
      REAL       GBT   ( IDIM, JDIM, KMAX )  !" 温度  Ｔ
      REAL       GBPS  ( IDIM, JDIM       )  !" 地表気圧
      REAL       GBQ   ( IDIM, JDIM, KMAX )  !" 比湿  ｑ
      REAL       GBVOR ( IDIM, JDIM, KMAX )  !" 渦度  ζ
      REAL       GBDIV ( IDIM, JDIM, KMAX )  !" 発散  Ｄ
      REAL       GBTG  ( IDIM, JDIM )        !" 地面温度Ｔｇ
*"       : 格子点データ(t-Δt) <DYNMCS>  格子点データ(t)
*
      REAL       GTUA  ( IDIM, JDIM, KMAX )  !" 東西運動量変化項ＵＡ
      REAL       GTVA  ( IDIM, JDIM, KMAX )  !" 南北運動量変化項ＶＡ
      REAL       GTH   ( IDIM, JDIM, KMAX )  !" 温度時間変化項  Ｈ
      REAL       GTR   ( IDIM, JDIM, KMAX )  !" 比湿時間変化項  Ｒ
      REAL       MSORC ( IDIM, JDIM, KMAX )  !" 質量変化項
*"                                          追加 ishiwatari(93/10/08)
*"       : <PHYSCS> 格子点変化項(P) <DYNMCS> 格子点変化項(P+D)
*
      INTEGER    ISTEP                 !" 通しステップ数
      INTEGER    ITA                   !" 通し時間(t)
      INTEGER    ITB                   !" 通し時間(t-Δt)
      INTEGER    IDATEA( 6 )           !" 時刻：年月日時分秒
      INTEGER    IDATEB( 6 )           !" 時刻：年月日時分秒
      REAL       DELT                  !" 時間刻みΔt
      REAL       DELTP                 !" 物理過程時間刻みΔt
      LOGICAL    OADVNC                !" 時刻が進行するか否か
      LOGICAL    ORSTR                 !" 再出発出力するか否か
*"       : 時刻等
*
*   [ONCE]
      INTEGER    ITSTRT                !" 計算開始時刻
      INTEGER    ITEND                 !" 計算終了時刻
      INTEGER    IORSTR                !" 出力間隔：再出発
*"       : 実験管理パラメータ
*
      INTEGER    IDELT                 !" 標準時間刻み
      INTEGER    INISTP                !" 初期ステップ数
      REAL       TFIL                  !" 時間フィルター係数
*"       : 時間ステップパラメータ
*
*"    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
*     REAL       FKARM                 !" Karman 定数
*"    COMMON /COMCON/ end
*"       : 物理パラメータ
*
      REAL       ALAT  ( JDIM )        !" 緯度
      REAL       DLAT  ( JDIM )        !" 緯度荷重
      REAL       ALON  ( IDIM )        !" 経度
      REAL       DLON  ( IDIM )        !" 経度荷重
      REAL       SIG   ( KMAX )        !" σレベル(整数)
      REAL       SIGM  (KMAX+1)        !" σレベル(半整数)
      REAL       DSIG  ( KMAX )        !" Δσ(整数)
      REAL       DSIGM (KMAX+1)        !" Δσ(半整数)
*"       : 座標値
*
*   [WORK]
      COMMON    /COMWRK/ WORK
      REAL       WORK  ( NWORK )       !" ワーク領域
*
*
*" << SETPUP : 初期設定 >>
*
      CALL CLCSTR ( 'SETUP' )
      CALL YPREP                       !" システム前処理 
*
      CALL SETPAR                      !" 実験パラメータ
     O         ( ITSTRT, ITEND , IORSTR,
     O           IDELT , INISTP, TFIL    )
*
      CALL SETCOR                      !" 座標値
     O         ( ALON  , DLON  ,
     O           ALAT  , DLAT  ,
     O           SIG   , DSIG  ,
     O           SIGM  , DSIGM  )
*
      CALL RDSTRT                      !" 初期値の読み込みと再生成
     O         ( GAU   , GAV   , GAT   , GAPS  , GAQ   ,
     O           GAVOR , GADIV ,
     O           GBU   , GBV   , GBT   , GBPS  , GBQ   ,
     O           GBVOR , GBDIV ,
     O           ITA   , ITB   , IDATEA, IDATEB, ISTEP ,
     C           ITSTRT, ALAT  , DLAT                    )
*
      CALL ADMXMN 
     I         ( GAU   , GAV   , GAT   , GAPS  , GAQ   ,
     I           GADIV , GAVOR , ITA   , 'start GA'      )
      CALL ADMXMN 
     I         ( GBU   , GBV   , GBT   , GBPS  , GBQ   ,
     I           GBDIV , GBVOR , ITB   , 'start GB'      )
*
      CALL RDSTRG                      !" 地表初期値の読み込み
     O         ( GBTG  ,
     I           GBT   ,
     C           ITB     )
*
      CALL SETTIM                      !" 時刻を記憶 
     I         ( ITA   , ITB   , IDATEA, IDATEB, ISTEP  )
      CALL AHSTRG                      !" 標準時間平均出力の登録
*
      CALL CLCEND ( 'SETUP' )
*
*  << LOOP : <************* メイン・ループ >>
*
 5000 CONTINUE
*
#ifdef DEBUG
         CALL ADMXMN 
     I         ( GAU   , GAV   , GAT   , GAPS  , GAQ   ,
     I           GADIV , GAVOR , ITA   , 'begin LOOP'    )
#endif
         ISTEP = ISTEP + 1
*
*     << START : ステップはじめの処理 >>
*
         CALL CLCSTR ( 'TIMCON' )
*
         CALL TIMSTP                   !" 時間制御 
     O         ( DELT  , OADVNC, ORSTR ,
     I           ITA   , ITB   , IDATEA, IDATEB, ISTEP  ,
     C           IDELT , INISTP, ITEND , IORSTR          )
*
         CALL SAVEGB                   !" t-Δtのデータをセーブ
     I         ( GBU   , GBV   , GBT   , GBPS  , GBQ   ,
     I           GBVOR , GBDIV                           )
         CALL CLCEND ( 'TIMCON' )
*
*"    << INTEGR : 時間積分 >>
* 
        CALL CLCSTR ( 'PHYSCS' )
*
         DELTP = 2 * DELT 
*
         CALL PHYSCS                   !" 物理過程
     O         ( GTUA  , GTVA  , GTH   , GTR   , MSORC , 
     M           GBTG  ,
     I           GBU   , GBV   , GBT   , GBPS  , GBQ   ,
     I           GBVOR , GBDIV , 
     I           ITB   , IDATEB, DELTP , DELT , 
     C           ALON  , ALAT  ,
     C           SIG   , SIGM  , DSIG  , DSIGM          )
*"                           MSORC 追加 石渡(93/10/08)
*
         CALL CLCEND ( 'PHYSCS' )
*
         CALL CLCSTR ( 'DYNMCS' )
*
         CALL DYNMCS                   !" 力学項と時間積分
     M         ( GAU   , GAV   , GAT   , GAPS  , GAQ   ,
     M           GBU   , GBV   , GBT   , GBPS  , GBQ   ,
     M           GAVOR , GADIV , GBVOR , GBDIV ,
     M           GTUA  , GTVA  , GTH   , GTR   ,
     I           ITA   , DELT  , OADVNC, MSORC ,
     C           ALON  , DLON  , ALAT  , DLAT  ,
     C           SIG   , SIGM  , DSIG  , DSIGM           )
*"                           MSORC 追加 石渡(93/10/08)
         write (6,*) 'in aadm3: after dynmcs'
*
         CALL CLCEND ( 'DYNMCS' )
*
#ifdef DEBUG
         CALL ADMXMN 
     I         ( GAU   , GAV   , GAT   , GAPS  , GAQ   ,
     I           GADIV , GAVOR , ITA   , 'after DYNMCS'    )
#endif
*
*"    << ADJST : 積分後の調節 >>
*
         CALL CLCSTR ( 'PADJST' )
*
         write (6,*) 'in aadm3: before padjust'
         CALL PADJST                   !" 物理調節
     M         ( GAU   , GAV   , GAT   , GAPS  , GAQ   ,
     I           GAVOR , GADIV ,
     I           DELT*2.,
     C           SIG   , SIGM  , DSIG   , DSIGM         )
*
         CALL CLCEND ( 'PADJST' )
         CALL CLCSTR ( 'TFILT' )
*
         IF ( OADVNC ) THEN
            CALL TFILT                 !" タイムフィルター
     M         ( GBU   , GBV   , GBT   , GBPS  , GBQ   ,
     M           GBVOR , GBDIV ,
     I           GAU   , GAV   , GAT   , GAPS  , GAQ   ,
     I           GAVOR , GADIV ,
     C           TFIL                                   )
         ENDIF
*
         CALL CLCEND ( 'TFILT' )
*
*"    << OUTPUT : データ出力 >>
         IF ( OADVNC ) THEN
            CALL CLCSTR ( 'HISTIN' )
            CALL HISTIN ( GBU   , 'U'   ) !" 出力データの記憶
            CALL HISTIN ( GBV   , 'V'   )
            CALL HISTIN ( GBT   , 'T'   )
            CALL HISTIN ( GBPS  , 'PS'  )
            CALL HISTIN ( GBQ   , 'Q'   )
            CALL HISTIN ( GBVOR , 'VOR' )
            CALL HISTIN ( GBDIV , 'DIV' )
            CALL HISTIN ( GBTG  , 'TG'  )
            CALL CLCEND ( 'HISTIN' )
*
            CALL CLCSTR ( 'HISTOU' )
            CALL HISTRP
            CALL HISTOU                !" データを出力
            CALL CLCEND ( 'HISTOU' )
         ENDIF
*
*"    << NEXT : 次のステップへ >>
*
         CALL CLCSTR ( 'MISC' )
*
         CALL    ADVSTP                !" 時刻変数を進める
     O         ( ITA   , ITB   , IDATEA, IDATEB,
     I           OADVNC                          )
*
         IF ( ORSTR ) THEN
            CALL WRRSTR                !" リスタートファイル書き込み
     I         ( GAU   , GAV   , GAT   , GAPS  , GAQ   ,
     I           GAVOR , GADIV ,
     I           GBU   , GBV   , GBT   , GBPS  , GBQ   ,
     I           GBVOR , GBDIV ,
     I           ITA   , ITB   , IDATEA, IDATEB, ISTEP  )
*
            CALL WRRSTG   !" 地表リスタート・ファイルの書き込み
     I         ( GBTG  ,
     I           ITB   , IDATEB, ISTEP  )
         ENDIF
*
         CALL CLCEND ( 'MISC' )
*
*" << LEND : メイン・ループ終わり *************> >>
*
      IF ( .NOT. ( ITB .GE. ITEND )  ) GOTO  5000
*
      CALL CLCOUT                      !" CPU時間出力
      CALL YFINE                       !" システム後処理
*
      STOP
      END
***********************************************************************
      SUBROUTINE AHSTRG                !" 標準時間平均出力の登録
*
*   [INTERN PARAM]
      INTEGER    ISTYPL
      DATA       ISTYPL / 1 /
      REAL       VMISS
*
      CALL GZDBGT ( '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       ( 'T     ', 'temperature         ' ,'K     ', 'ALEV',
     I           VMISS , VMISS , 2.5   , 10.   , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(F12.3)' )
*
      CALL     HISTRG
     I       ( 'PS    ', 'surface pressure    ' ,'mb    ', 'ASFC',
     I           VMISS , VMISS , 2.5   , 10.   , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(F12.3)' )
*
      CALL     HISTRG
     I       ( 'Q     ', 'specific humidity   ' ,'g/g   ', 'ALEV',
     I           VMISS , VMISS , 1.E-3 , 5.E-3 , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(3PF12.3)' )
*
      CALL     HISTRG
     I       ( 'VOR   ', 'vorticity           ' ,'1/s   ', 'ALEV',
     I           VMISS , VMISS , 1.E-6 , 5.E-6 , ISTYPL  ,
     I         '   '   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      CALL     HISTRG
     I       ( 'DIV   ', 'divergence          ' ,'1/s   ', 'ALEV',
     I           VMISS , VMISS , 1.E-6 , 5.E-6 , ISTYPL  ,
     I         '   '   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      CALL     HISTRG
     I       ( 'TG    ', 'ground temperature  ' ,'K     ', 'ASFC',
     I           VMISS , VMISS , 2.5   , 10.   , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , 'X'     ,'(F12.3)' )
*
      RETURN
      END
*************************************************************************
      SUBROUTINE ADMXMN        !" debug monitor
     I         ( GDU   , GDV   , GDT   , GDPS  , GDQ   ,
     I           GDDIV , GDVOR , IT    , HLABEL          )
*
*   [PARAM]
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数, 波数
#else
#include        "zcdim.F"                    !" 格子点数, 波数
#endif
*
*   [INPUT] 
      REAL       GDU   ( IDIM, JDIM, KMAX )  !" 西風  ｕ
      REAL       GDV   ( IDIM, JDIM, KMAX )  !" 南風  ｖ
      REAL       GDT   ( IDIM, JDIM, KMAX )  !" 温度  Ｔ
      REAL       GDPS  ( IDIM, JDIM       )  !" 地表気圧
      REAL       GDQ   ( IDIM, JDIM, KMAX )  !" 比湿  ｑ
      REAL       GDVOR ( IDIM, JDIM, KMAX )  !" 渦度  ζ
      REAL       GDDIV ( IDIM, JDIM, KMAX )  !" 発散  Ｄ
      INTEGER    IT
      CHARACTER  HLABEL *(*)
*
      WRITE ( 6,* ) HLABEL, ' IT= ', IT
      CALL MAXMIN( GDU,   IDIM, JDIM, KMAX, IDIM, JDIM, 'U'   )
      CALL MAXMIN( GDV,   IDIM, JDIM, KMAX, IDIM, JDIM, 'V'   )
      CALL MAXMIN( GDT,   IDIM, JDIM, KMAX, IDIM, JDIM, 'T'   )
      CALL MAXMIN( GDPS,  IDIM, JDIM, 1,    IDIM, JDIM, 'PS'  )
      CALL MAXMIN( GDQ,   IDIM, JDIM, KMAX, IDIM, JDIM, 'Q'   )
      CALL MAXMIN( GDVOR, IDIM, JDIM, KMAX, IDIM, JDIM, 'VOR' )
      CALL MAXMIN( GDDIV, IDIM, JDIM, KMAX, IDIM, JDIM, 'DIV' )
*
      RETURN
      END
