*" PACKAGE XMKINIT  !" 初期値作成
*
*"  [HIS] 93/9/7(堀之内) INISET を適当に取り替えていろいろな初期場を
*"        つくれるように設定。今のところ静止大気中のノーマルモードの
*"        ルーチンがあるのみ。( freemode.F )
***********************************************************************
      PROGRAM MKINIT    !" 初期値メインルーチン
*
*   [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 )  !" 発散  Ｄ
*"       : 格子点データ(t-Δt) <DYNMCS>  格子点データ(t)
*
*
*   [INTERNAL PARM] 
      INTEGER    ISTEP                 !" 通しステップ数
      INTEGER    ITA                   !" 通し時間(t)
      INTEGER    ITB                   !" 通し時間(t-Δt)
      INTEGER    IDATEA( 6 )           !" 時刻：年月日時分秒
      INTEGER    IDATEB( 6 )           !" 時刻：年月日時分秒
*"       : 時刻等
*
      DATA       ITA, ITB     / 0 , 0 /
      DATA       IDATEA       / 1990, 1, 1, 0, 0, 0 /
      DATA       IDATEB       / 1990, 1, 1, 0, 0, 0 /
      DATA       ISTEP        / 0  /
*
      NAMELIST  /NMDATE/ ITA, ITB, IDATEA, IDATEB, ISTEP
*
      CHARACTER  HDSET *(NCC)
      CHARACTER  HFILE *(NFILN)
      CHARACTER  HDFMT *(NCC)
**      DATA       HDFMT  / 'UR8' /   !" 初期値ファイル用
      DATA       HDFMT  / 'UR4' /   !" gtcont などで見るため
      INTEGER    JFLRST 
      DATA       JFLRST / 41 /
*
*   [INTERNAL WORK] 
      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)        !" Δσ(半整数)
*
      CALL YPREP
      CALL PCONST
      CALL GTOPEN
      IF ( HDFMT.EQ.'UR4' ) 
     &     CALL MSGDMP('W',' MAIN ','REAL*4 DATA TO BE CREATED')
*
      WRITE( 6,*     ) ' DATA NAME  ?'
      READ ( 5,'(A)' ) HDSET
      WRITE( 6,*     ) ' FILE NAME  ?'
      READ ( 5,'(A)' ) HFILE
      CALL GFWOPN ( JFLRST, HFILE )
      WRITE ( 6,NMDATE )
      WRITE ( 6,*      ) ' ENTER NAMELST NMDATE?'
      CALL   REWNML ( IFPAR , JFPAR )
      READ  ( IFPAR, NMDATE, END=1910 )
 1910 CONTINUE
*
      CALL GTCSET( 'DDSET' , HDSET     )
*
      CALL SETCOR
     O         ( ALON  , DLON  ,
     O           ALAT  , DLAT  ,
     O           SIG   , DSIG  ,
     O           SIGM  , DSIGM  )
*
      CALL INISET               !" 初期値設定
     O         ( GAU   , GAV   , GAT   , GAPS  , GAQ   ,
     I           ALON  , DLON  , ALAT  , DLAT  ,
     I           SIG   , DSIG  , SIGM  , DSIGM  )
*
      CALL COPY ( GBU  , GAU  , IDIM*JDIM*KMAX )
      CALL COPY ( GBV  , GAV  , IDIM*JDIM*KMAX )
      CALL COPY ( GBT  , GAT  , IDIM*JDIM*KMAX )
      CALL COPY ( GBQ  , GAQ  , IDIM*JDIM*KMAX )
      CALL COPY ( GBPS , GAPS , IDIM*JDIM      )
*
         CALL DSTRT             !" 初期データの再生成
     M        (  GBU   , GBV   , GBT   , GBPS  , GBQ   ,
     O           GBVOR , GBDIV ,
     C           ALAT  , DLAT                           )
*
         CALL DSTRT             !" 初期データの再生成
     M        (  GAU   , GAV   , GAT   , GAPS  , GAQ   ,
     O           GAVOR , GADIV ,
     C           ALAT  , DLAT                           )
*
      CALL WRRSTX           !" 基本リスタート・ファイルの書き込み
     I         ( GAU   , GAV   , GAT   , GAPS  , GAQ   ,
     I           GBU   , GBV   , GBT   , GBPS  , GBQ   ,
     I           ITA   , ITB   , IDATEA, IDATEB, ISTEP ,
     I           JFLRST, HDFMT                            )
*
      CALL WRRSTY           !" 渦度発散リスタート・ファイルの書き込み
     I         ( GAVOR , GADIV ,
     I           GBVOR , GBDIV ,
     I           ITA   , ITB   , IDATEA, IDATEB, ISTEP ,
     I           JFLRST, HDFMT                            )
*
ccc      CALL GTCLSE
ccc    % xmkinit00.F 中の CALL GTCLSE はコメントアウトすること。
ccc   「stupid用誰でもできちゃう AGCM5 体験」 by 堀之内(96/12/12)

      CALL YFINE
*
      STOP
      END


