*" PACKAGE ASTEDY !" 線型解析メインルーチン
*"                  ver 1.1                   93/07/14 takepiro
***********************************************************************
      PROGRAM GSTEDY                         !" メインルーチン
*
*"    Boussinesq 全球モデル
*"      初期値を非線形強制力とする帯状平均線型定常解を求める
*
*   [PARAM]
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数, 波数
      INCLUDE   (ZLDIM)                      !" パラメター数, 係数行列
      INCLUDE   (ZHDIM)                      !" 文字列文字数
      INCLUDE   (ZCCOM)                      !" 標準物理定数
#else
#include        "zcdim.F"                    !" 格子点数, 波数
#include        "zldim.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)
*
      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]
      COMMON    /COMWRK/ WORK
      REAL       WORK  ( MATDMX*MATDMX  )   !" ワーク領域
*
      INTEGER    IUNIT                      !" 標準出力装置番号
*
*
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, * )' LINEAR ANALYSIS GSTEDY'
     &                   //NAME
     &                   //' ver.1.1, 93/07/14'
*
      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   , 'after RDSTRT'    )
*
      CALL DHSTRG
*
      CALL SETTIM                      !" 時刻を記憶 
     I         ( ITA-IDELT, ISTEP-1  )
      CALL HISTOU
*
      CALL SETTIM                      !" 時刻を記憶 
     I         ( ITA   , ISTEP  )
*
      CALL CLCEND ( 'SETUP' )
*
*  << 定常解計算 (入力:非線形項計算, 出力:線型定常解) >>
*
      CALL LSTEDY               !" 定常解計算
     M         ( GAU   , GAV   , GAW   , GAT   , 
     M           GATOR , GAPOR , 
     I           0     , 
     C           ALON  , DLON  , ALAT  , DLAT  ,
     C           ARAD  , DRAD                    )
*
      CALL ADMXMN 
     I         ( GAU   , GAV   , GAW   , GAT   , 
     I           GATOR , GAPOR , ITA   , 'after LSTDY'    )
*
*"    << OUTPUT : データ出力 >>
*
      CALL WRRSTR               !" リスタートファイル書き込み
     I         ( GAU   , GAV   , GAW   , GAT   , 
     I           GATOR , GAPOR ,
     I           ITA   , ISTEP                    )
*
      CALL SETTIM                      !" 時刻を記憶 
     I         ( ITA   , ISTEP  )
*
      CALL HISTOU
*
      CALL CLCOUT                      !" CPU時間出力
      CALL YFINE                       !" システム後処理
*
      STOP
      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