*" PACKAGE AADMIN !" 共通 メインルーチン
*"                  ver 1.00                   92/10/13 takepiro
***********************************************************************
      PROGRAM GAMRAS                           !" メインルーチン
*
*"    Boussinesq 全球モデル
*"      one-level time integration
*
*   [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, 0:KDIM )  !" 西風   ｕ
      REAL       GAV   ( IDIM, JDIM, 0:KDIM )  !" 南風   ｖ
      REAL       GAW   ( IDIM, JDIM, 0:KDIM )  !" 鉛直風 ｗ
      REAL       GAT   ( IDIM, JDIM, 0:KDIM )  !" 温度   Ｔ
      REAL       GATOR ( IDIM, JDIM, 0:KDIM )  !" トロイダル Ψ
      REAL       GAPOR ( IDIM, JDIM, 0:KDIM )  !" ポロイダル Φ
*"       : 格子点データ(t) <DYNMCS>  格子点データ(t+Δt)
*
      REAL       GTUA  ( IDIM, JDIM, 0:KDIM )  !" 東西運動量変化項ＵＡ
      REAL       GTVA  ( IDIM, JDIM, 0:KDIM )  !" 南北運動量変化項ＶＡ
      REAL       GTH   ( IDIM, JDIM, 0:KDIM )  !" 温度時間変化項  Ｈ
*"       : <PHYSCS> 格子点変化項(P) <DYNMCS> 格子点変化項(P+D)
*
      INTEGER    ISTEP                 !" 通しステップ数
      INTEGER    ITA                   !" 通し時間(t), 標準時間単位
c$$$      INTEGER    IDATEA( 6 )           !" 時刻年月日時分秒(ダミー)
      REAL       DELT                  !" 時間刻みΔt(DAY)
      LOGICAL    OADVNC                !" 時刻が進行するか否か
      LOGICAL    ORSTR                 !" 再出発出力するか否か
*"       : 時刻等
*
*   [ONCE]
      INTEGER    ITSTRT                !" 計算開始時刻(標準時間単位)
      INTEGER    ITEND                 !" 計算終了時刻(標準時間単位)
      INTEGER    IORSTR                !" 出力間隔：再出発(標準時間単位)
*"       : 実験管理パラメータ
*
      INTEGER    IDELT                 !" 標準時間刻み(SEC)
*"       : 時間ステップパラメータ
*
*"    COMMON /COMCON/ ( include ZCCOM )
*     REAL       ERI                          !" 内径
*     REAL       ERO                          !" 外径
*     REAL       ETA                          !" 内径/外径
*"    COMMON /COMCON/ end
*"       : 物理パラメータ
*
      REAL       ALAT  ( JDIM )        !" 緯度
      REAL       DLAT  ( JDIM )        !" 緯度荷重
      REAL       ALON  ( IDIM )        !" 経度
      REAL       DLON  ( IDIM )        !" 経度荷重
      REAL       ARAD  ( 0:KDIM )      !" ｒレベル(整数)
      REAL       DRAD  ( 0:KDIM )      !" Δｒ(整数)
*"       : 座標値
*
*   [WORK]
      INTEGER    IUNIT                 !" 標準出力装置番号
*
      COMMON    /COMWRK/ WORK
      REAL       WORK  ( NWORK )       !" ワーク領域
*
c$$$      DATA      IDATEA / 1992, 12, 18, 0, 0, 0/
*
#ifdef DEBUG
      external common_handler
      integer i, ieee_handler
      i = ieee_handler("set","common",common_handler )
      if( i.ne. 0 ) print *, "Could not establish fp signal handler"
#endif
*
*" << SETPUP : 初期設定 >>
*
      CALL GLPGET( 'MSGUNIT', IUNIT )
      WRITE ( IUNIT, * ) ' 3DIM BOUSSINESQ MODEL GAMRAS'
     &                   //NAME
     &                   //' ver.1.0, 92/10/13'
*
      CALL CLCSTR ( 'SETUP' )
      CALL YPREP                       !" システム前処理 
*
      CALL SETPAR                      !" 実験パラメータ
     O         ( ITSTRT , ITEND , IORSTR ,
     O           IDELT                      )
*
      CALL SETCOR                      !" 座標値
     O         ( ALON  , DLON  ,
     O           ALAT  , DLAT  ,
     O           ARAD  , DRAD   )
*
      CALL RDSTRT                      !" 初期値の読み込みと再生成
     O         ( GAU   , GAV   , GAW   , GAT   , 
     O           GATOR , GAPOR ,
     O           ITA   , ISTEP ,
     C           ITSTRT, ALAT  , DLAT  , ARAD  , DRAD     )
*
      CALL ADMXMN 
     I         ( GAU   , GAV   , GAW   , GAT   , 
     I           GATOR , GAPOR , ITA   , 'start GA'      )
*
      CALL SETTIM                      !" 時刻を記憶 
     I         ( ITA   , ISTEP  )
      CALL AHSTRG                      !" 標準時間平均出力の登録
*
      CALL CLCEND ( 'SETUP' )
*
*  << LOOP : <************* メイン・ループ >>
*
 5000 CONTINUE
*
#ifdef DEBUG
         CALL ADMXMN 
     I         ( GAU   , GAV   , GAW   , GAT   , 
     I           GATOR , GAPOR , ITA   , 'begin LOOP'    )
#endif
         ISTEP = ISTEP + 1
*
*     << START : ステップはじめの処理 >>
*
         CALL CLCSTR ( 'TIMCON' )
*
         CALL TIMSTP                   !" 時間制御 
     O         ( DELT  , OADVNC , ORSTR ,
     I           ITA   , ISTEP  ,
     C           IDELT , ITEND , IORSTR          )
*
         CALL CLCEND ( 'TIMCON' )
*
*"    << INTEGR : 時間積分 >>
* 
         CALL CLCSTR ( 'DYNMCS' )
*
         CALL DYNMCS                   !" 力学項と時間積分
     M         ( GAU   , GAV   , GAW   , GAT   , 
     M           GATOR , GAPOR , 
     I           ITA   , DELT  , OADVNC,
     C           ALON  , DLON  , ALAT  , DLAT  ,
     C           ARAD  , DRAD                    )
*
         CALL CLCEND ( 'DYNMCS' )
*
#ifdef DEBUG
         CALL ADMXMN 
     I         ( GAU   , GAV   , GAW   , GAT   , 
     I           GATOR , GAPOR , ITA   , 'after DYNMCS'    )
#endif
*
*"    << ADJST : 積分後の調節 >>
*
*"           調節過程なし
*
*
*"    << OUTPUT : データ出力 >>
         CALL    ADVSTP                !" 時刻変数を進める
     O         ( ITA   ,  
     I           OADVNC          )
*
         IF ( OADVNC ) THEN
            CALL CLCSTR ( 'HISTIN' )
            CALL HISTIN ( GAU   , 'U'   ) !" 出力データの記憶
            CALL HISTIN ( GAV   , 'V'   )
            CALL HISTIN ( GAW   , 'W'   )
            CALL HISTIN ( GAT   , 'T'   )
            CALL HISTIN ( GATOR , 'TOR' )
            CALL HISTIN ( GAPOR , 'POR' )
            CALL CLCEND ( 'HISTIN' )
*
            CALL CLCSTR ( 'HISTOU' )
            CALL HISTRP
            CALL HISTOU                !" データを出力
            CALL CLCEND ( 'HISTOU' )
         ENDIF
*
*"    << NEXT : 次のステップへ >>
*
         CALL CLCSTR ( 'MISC' )
*
         IF ( ORSTR ) THEN
            CALL WRRSTR                !" リスタートファイル書き込み
     I         ( GAU   , GAV   , GAW   , GAT   , 
     I           GATOR , GAPOR ,
     I           ITA   , ISTEP                    )
         ENDIF
*
         CALL CLCEND ( 'MISC' )
*
*" << LEND : メイン・ループ終わり *************> >>
*
      IF ( .NOT. ( ITA .GE. ITEND )  ) GOTO  5000
*
      CALL ADMXMN 
     I      ( GAU   , GAV   , GAW   , GAT   , 
     I        GATOR , GAPOR , ITA   , 'end PROGRAM'    )

      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 , 0.1   , 0.5   , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , ' '     ,'(F12.3)' )
*
      CALL     HISTRG
     I       ( 'V     ', 'v-velocity          ' ,'m/s   ', 'ALEV',
     I           VMISS , VMISS , 0.1   , 0.5   , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , ' '     ,'(F12.3)' )
*
      CALL     HISTRG
     I       ( 'W     ', 'w-velocity          ' ,'m/s   ', 'ALEV',
     I           VMISS , VMISS , 0.1   , 0.5   , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , ' '     ,'(F12.3)' )
*
      CALL     HISTRG
     I       ( 'T     ', 'temperature         ' ,'K     ', 'ALEV',
     I           VMISS , VMISS , 0.1   , 0.5   , ISTYPL  ,
     I         'CON'   , '   ' , 0     , 0     , ' '     ,'(F12.3)' )
*
      CALL     HISTRG
     I       ( 'TOR   ', 'toroidal potential  ' ,'1/s   ', 'ALEV',
     I           VMISS , VMISS , 0.1   , 0.5   , ISTYPL  ,
     I         '   '   , '   ' , 0     , 0     , ' '     ,'(1PE12.3)' )
*
      CALL     HISTRG
     I       ( 'POR   ', 'poroidal potential  ' ,'1/s   ', 'ALEV',
     I           VMISS , VMISS , 0.1   , 0.5   , ISTYPL  ,
     I         '   '   , '   ' , 0     , 0     , ' '     ,'(1PE12.3)' )
*
      RETURN
      END
*************************************************************************
      SUBROUTINE ADMXMN        !" debug monitor
     I         ( GDU   , GDV   , GDW   , GDT   , 
     I           GDTOR , GDPOR , 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       GDW   ( IDIM, JDIM, KMAX )  !" 鉛直風 ｗ
      REAL       GDT   ( IDIM, JDIM, KMAX )  !" 温度   Ｔ
      REAL       GDTOR ( IDIM, JDIM, KMAX )  !" トロイダル Ψ
      REAL       GDPOR ( 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( GDW,   IDIM, JDIM, KMAX, IDIM, JDIM, 'W'   )
      CALL MAXMIN( GDT,   IDIM, JDIM, KMAX, IDIM, JDIM, 'T'   )
      CALL MAXMIN( GDTOR, IDIM, JDIM, KMAX, IDIM, JDIM, 'TOR' )
      CALL MAXMIN( GDPOR, IDIM, JDIM, KMAX, IDIM, JDIM, 'POR' )
*
      RETURN
      END
