*" PACKAGE AADMIN !" 共通 メインルーチン
*"                  ver 1.00                   92/06/11 numaguti
*"                  SRC:=$GC/model/agcm5/src/admin/aadmn.F
*"                  DOC:=$GC/model/agcm5/doc/main.tex
*" 履歴  93/08/29 保坂征宏  PHYSICS 周辺変更
*" 履歴  97/09/22 堀之内武  AHSTRGの仕様変更. HISTRG を呼ぶ際にデフォルト
*" ファイル名上書きをやめる(HISTRGの後ろから6番目の引数を'CON'から' 'に)
***********************************************************************
      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 )  !" 比湿時間変化項  Ｒ
*"       : <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 !"保坂93/08/29追加 
      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 )       !" ワーク領域
      INTEGER   I, J, K
*

      REAL  gdtphy( idim, jdim, kmax )
      REAL  gduphy( idim, jdim, kmax )
      REAL  gdvphy( idim, jdim, kmax )
      REAL  gteq( idim, jdim, kmax )
      REAL  gpp( idim, jdim, kmax )
      REAL  p0, kt, ka, ks, kf, kv, sigb, dty, dthetaz
      REAL  kappa, day

      REAL  tphy( idim, jdim, kmax )
      REAL  uphy( idim, jdim, kmax )
      REAL  vphy( idim, jdim, kmax )

c$$$      REAL       UVFACT ( IDIM, JDIM )       !" u→U のファクター

      REAL       WAVOR ( NMDIM , KMAX     )  !" 渦度  ζ
      REAL       WADIV ( NMDIM , KMAX     )  !" 発散  Ｄ
      
*
*" << 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                          !" 93/08/29 保坂追加
*
c$$$         CALL PHYSCS                   !" 物理過程    93/08/29 保坂変更  
c$$$     O         ( GTUA  , GTVA  , GTH   , GTR   , 
c$$$     M           GBTG  ,
c$$$     I           GBU   , GBV   , GBT   , GBPS  , GBQ   ,
c$$$     I           GBVOR , GBDIV , 
c$$$     I           ITB   , IDATEB, DELTP , DELT , 
c$$$     C           ALON  , ALAT  ,
c$$$     C           SIG   , SIGM  , DSIG  , DSIGM          )
*

         DO 2100 K = 1, KMAX
            DO 2100 J = 1, JMAX
               DO 2100 I = 1, IMAX
                  GTUA( I, J, K ) = 0.
                  GTVA( I, J, K ) = 0.
                  GTH( I, J, K )  = 0.
                  GTR( I, J, K )  = 0.
 2100       CONTINUE

         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,
     C           ALON  , DLON  , ALAT  , DLAT  ,
     C           SIG   , SIGM  , DSIG  , DSIGM           )
*
         CALL CLCEND ( 'DYNMCS' )
*

c$$$         do k = 1, KMAX
c$$$            write(*,*) 'SIG (', k, ') =', 
c$$$     &                 SIG ( k )
c$$$         end do
c$$$     
c$$$         do k = 1, KMAX + 1
c$$$            write(*,*) 'SIGM (', k, ') =', 
c$$$     &                 SIGM ( k )
c$$$         end do
c$$$     
c$$$         do k = 1, KMAX
c$$$            write(*,*) 'DSIG (', k, ') =', 
c$$$     &                 DSIG ( k )
c$$$         end do
c$$$     
c$$$         do k = 1, KMAX + 1
c$$$            write(*,*) 'DSIGM (', k, ') =', 
c$$$     &                 DSIGM ( k )
c$$$         end do
     
         day = 86400.0d0
         kappa = RAIR / CP
         p0 = 1000.0d0
c$$$         p0 = 1000.0d0 * 1.0d2
         sigb    = 0.7d0
         ka      = 1.0d0 / ( 40.0d0 * day )
         ks      = 1.0d0 / ( 4.0d0 * day )
         dty     = 60.0d0
         dthetaz = 10.0d0

c$$$         DO I = 1, IDIM
c$$$            DO J = 1, JDIM
c$$$               UVFACT ( I,J ) = COS( ALAT( J ) )
c$$$            END DO
c$$$         END DO

c$$$         do j = 1, jdim
c$$$            write(*,*) 'ALAT(', j, ')=', ALAT( j )
c$$$         end do

c$$$         write(*,*) 'GAPS=', GAPS

         do k = 1, kmax
            do j = 1, jdim
               do i = 1, idim
                  gpp (i,j,k) = SIG( k ) * GAPS (i, j)
c$$$                  write(*,*) 'gpp (', i, ',', j, ',', k, ')/p0=',
c$$$     &                 gpp( i, j, k ) / p0
               end do
            end do
         end do

         do k = 1, KMAX
            do j = 1, JDIM
               do i = 1, IDIM
                  gteq( i, j, k ) = max( 200.0d0,
     &                 (   315.0d0
     &                   - dty * sin( ALAT( j ) ) ** 2
     &                   - dthetaz * log( gpp( i, j, k ) / p0 )
     &                     * cos( ALAT( j ) ) ** 2 )
     &                       * ( gpp( i, j, k ) / p0 )**kappa )
               enddo
            enddo
         enddo

         do k = 1, KMAX
            do j = 1, JDIM
               do i = 1, IDIM
                  kt =   ka
     &                 + ( ks - ka )
     &                   * max( 0.0d0,
     &                      ( SIG ( k ) - sigb ) / ( 1.0d0 - sigb ) )
     &                       * cos( ALAT(j) ) ** 4

                  gdtphy( i, j, k ) =
     &                 - kt * ( GAT( i, j, k ) - gteq( i, j, k ) )
               enddo
            enddo
         enddo

         do k = 1, KMAX
            do j = 1, JDIM
               do i = 1, IDIM
                  GAT ( i, j, k ) = GAT ( i, j, k )
     &                 + DELT * 2.0d0 * gdtphy( i, j, k )
                  tphy ( i, j, k ) = DELT * 2.0d0 * gdtphy( i, j, k )
               enddo
            enddo
         enddo

         kf   = 1.0d0 / day

c$$$         write(*,*) 'kf=', kf
c$$$
c$$$         do k = 1, KMAX
c$$$            write(*,*) 'SIG (', k, ')=', SIG
c$$$         end do
c$$$
c$$$         do k = 1, KMAX
c$$$            write(*,*) 'SIG (', k, ') - sigb =',
c$$$     &           SIG ( k ) - sigb
c$$$         end do
c$$$         
c$$$         do k = 1, KMAX
c$$$            write(*,*) '( SIG (', k, ') - sigb ) / ( 1.0d0 - sigb ) =',
c$$$     &           ( SIG ( k ) - sigb ) / ( 1.0d0 - sigb )
c$$$         end do
c$$$
c$$$         do k = 1, KMAX
c$$$            write(*,*) 'max ( 0.0d0, ( SIG (', k,
c$$$     &           ') - sigb ) / ( 1.0d0 - sigb ) ) =',
c$$$     &           max( 0.0d0,
c$$$     &                      ( SIG ( k ) - sigb ) / ( 1.0d0 - sigb ) )
c$$$         end do
         
         do k = 1, KMAX
            do j = 1, JDIM
               do i = 1, IDIM
                  kv = kf * max( 0.0d0,
     &                      ( SIG ( k ) - sigb ) / ( 1.0d0 - sigb ) )

                  gduphy( i, j, k ) = - kv * GAU( i, j, k )
                  gdvphy( i, j, k ) = - kv * GAV( i, j, k )

c$$$                  write(*,*) 'kv (', i, ',', j, ',', k, ')=', 
c$$$     &                 kv
               enddo
            enddo
         enddo

c$$$         do k = 1, KMAX
c$$$            do j = 1, JDIM
c$$$               do i = 1, IDIM
c$$$                  write(*,*) 'GAU (', i, ',', j, ',', k, ')=', 
c$$$     &                 GAU ( i, j, k )
c$$$               enddo
c$$$            enddo
c$$$         enddo
c$$$
c$$$         do k = 1, KMAX
c$$$            do j = 1, JDIM
c$$$               do i = 1, IDIM
c$$$                  write(*,*) 'gduphy (', i, ',', j, ',', k, ')=', 
c$$$     &                 gduphy ( i, j, k )
c$$$               enddo
c$$$            enddo
c$$$         enddo

c -------------- hs94 無効有効切り替え ここから (上に続く) 
              
         do k = 1, KMAX
            do j = 1, JDIM
               do i = 1, IDIM
                  GAU ( i, j, k ) = GAU ( i, j, k )
     &                 + DELT * 2.0d0 * gduphy( i, j, k )
                  uphy ( i, j, k ) = DELT * 2.0d0 * gduphy( i, j, k )
                  GAV ( i, j, k ) = GAV ( i, j, k )
     &                 + DELT * 2.0d0 * gdvphy( i, j, k )
                  vphy ( i, j, k ) = DELT * 2.0d0 * gdvphy( i, j, k )
               enddo
            enddo
         enddo

         CALL DSMV2S
     O        ( WADIV, WAVOR,
     I          GAU, GAV,
     I          '    ' )

         CALL DSMS2V
     O        ( GAU, GAV,
     I          WADIV, WAVOR,
     I          '    '        )

         CALL DSMS2G
     O         ( GAVOR ,
     I           WAVOR  )

         CALL DSMS2G
     O         ( GADIV ,
     I           WADIV  )
         
c -------------- hs94 無効有効切り替え ここまで
         
c$$$         do k = 1, KMAX
c$$$            do j = 1, JDIM
c$$$               do i = 1, IDIM
c$$$                  write(*,*) 'GAU1(', i, ',', j, ',', k, ')=', 
c$$$     &                 GAU ( i, j, k )
c$$$               enddo
c$$$            enddo
c$$$         enddo
c$$$         
c$$$         CALL DSMV2S
c$$$     O        ( WADIV, WAVOR,
c$$$     I          GAU, GAV,
c$$$     I          '    ' )
c$$$
c$$$         CALL DSMS2V
c$$$     O        ( GAU, GAV,
c$$$     I          WADIV, WAVOR,
c$$$     I          '    '        )
c$$$
c$$$         do k = 1, KMAX
c$$$            do j = 1, JDIM
c$$$               do i = 1, IDIM
c$$$                  write(*,*) 'GAU2(', i, ',', j, ',', k, ')=', 
c$$$     &                 GAU ( i, j, k )
c$$$               enddo
c$$$            enddo
c$$$         enddo
c$$$
c$$$         CALL DSMV2S
c$$$     O        ( WADIV, WAVOR,
c$$$     I          GAU, GAV,
c$$$     I          '    ' )
c$$$
c$$$         CALL DSMS2V
c$$$     O        ( GAU, GAV,
c$$$     I          WADIV, WAVOR,
c$$$     I          '    '        )
c$$$
c$$$         do k = 1, KMAX
c$$$            do j = 1, JDIM
c$$$               do i = 1, IDIM
c$$$                  write(*,*) 'GAU3(', i, ',', j, ',', k, ')=', 
c$$$     &                 GAU ( i, j, k )
c$$$               enddo
c$$$            enddo
c$$$         enddo


#ifdef DEBUG
         CALL ADMXMN 
     I         ( GAU   , GAV   , GAT   , GAPS  , GAQ   ,
     I           GADIV , GAVOR , ITA   , 'after DYNMCS'    )
#endif
*
*"    << ADJST : 積分後の調節 >>
*
         CALL CLCSTR ( 'PADJST' )
*
c$$$         CALL PADJST                   !" 物理調節
c$$$     M         ( GAU   , GAV   , GAT   , GAPS  , GAQ   ,
c$$$     I           GAVOR , GADIV ,
c$$$     I           DELT*2.,
c$$$     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 HISTIN ( gteq  , 'gteq'  )
            CALL HISTIN ( uphy  , 'uphy'  )
            CALL HISTIN ( vphy  , 'vphy'  )
            CALL HISTIN ( tphy  , 'tphy'  )
            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, DIVSX, DIVLX
*
      CALL GZDBGT ( 'MISS', VMISS )   !" 欠損値
*
      DIVSX = 2.5
      DIVLX = 10.
      CALL     HISTRG                  !" 出力の登録
     I       ( 'U     ', 'u-velocity          ' ,'m/s   ', 'ALEV',
     I            VMISS,  VMISS,  DIVSX,  DIVLX,  ISTYPL,
     I         ' '     , '   ' , 0     , 0     , 'X'     ,'(F12.3)' )
*
      CALL     HISTRG
     I       ( 'V     ', 'v-velocity          ' ,'m/s   ', 'ALEV',
     I            VMISS,  VMISS,  DIVSX,  DIVLX,  ISTYPL,
     I         ' '     , '   ' , 0     , 0     , 'X'     ,'(F12.3)' )
*
      CALL     HISTRG
     I       ( 'T     ', 'temperature         ' ,'K     ', 'ALEV',
     I            VMISS,  VMISS,  DIVSX,  DIVLX,  ISTYPL,
     I         ' '     , '   ' , 0     , 0     , 'X'     ,'(F12.3)' )
*
      CALL     HISTRG
     I       ( 'PS    ', 'surface pressure    ' ,'mb    ', 'ASFC',
     I            VMISS,  VMISS,  DIVSX,  DIVLX,  ISTYPL,
     I         ' '     , '   ' , 0     , 0     , 'X'     ,'(F12.3)' )
*
      CALL     HISTRG
     I       ( 'gteq  ', 'eq temperature      ' ,'K     ', 'ALEV',
     I            VMISS,  VMISS,  DIVSX,  DIVLX,  ISTYPL,
     I         '   '   , '   ' , 0     , 0     , 'X'     ,'(F12.3)' )
*
      CALL     HISTRG
     I       ( 'uphy  ', 'u tendency with hs94' ,'m/s    ', 'ALEV',
     I            VMISS,  VMISS,  DIVSX,  DIVLX,  ISTYPL,
     I         '   '   , '   ' , 0     , 0     , 'X'     ,'(F12.3)' )
*
      CALL     HISTRG
     I       ( 'vphy  ', 'v tendency with hs94' ,'m/s    ', 'ALEV',
     I            VMISS,  VMISS,  DIVSX,  DIVLX,  ISTYPL,
     I         '   '   , '   ' , 0     , 0     , 'X'     ,'(F12.3)' )
*
      CALL     HISTRG
     I       ( 'tphy  ', 't tendency with hs94' ,'K      ', 'ALEV',
     I            VMISS,  VMISS,  DIVSX,  DIVLX,  ISTYPL,
     I         '   '   , '   ' , 0     , 0     , 'X'     ,'(F12.3)' )
*
      DIVSX = 1.E-6
      DIVLX = 5.E-6
      CALL     HISTRG
     I       ( 'Q     ', 'specific humidity   ' ,'g/g   ', 'ALEV',
     I            VMISS,  VMISS,  DIVSX,  DIVLX,  ISTYPL,
     I         ' '     , '   ' , 0     , 0     , 'X'     ,'(3PF12.3)' )
*
      CALL     HISTRG
     I       ( 'VOR   ', 'vorticity           ' ,'1/s   ', 'ALEV',
     I            VMISS,  VMISS,  DIVSX,  DIVLX,  ISTYPL,
     I         '   '   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      CALL     HISTRG
     I       ( 'DIV   ', 'divergence          ' ,'1/s   ', 'ALEV',
     I            VMISS,  VMISS,  DIVSX,  DIVLX,  ISTYPL,
     I         '   '   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      DIVSX = 2.5
      DIVLX = 10.
      CALL     HISTRG
     I       ( 'TG    ', 'ground temperature  ' ,'K     ', 'ASFC',
     I            VMISS,  VMISS,  DIVSX,  DIVLX,  ISTYPL,
     I         ' '     , '   ' , 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
