*" PACKAGE XMKINIT  !" 初期値作成
*"       v00l32:1 次元平衡解初期値(Ts=300K)
*
***********************************************************************
      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 )  !" 比湿  ｑ
*"       : 格子点データ(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 )  !" 比湿  ｑ
*"       : 格子点データ(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' /
      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
*
      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?'
      READ  ( 5,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           SIG                                      )
*
      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 WRRSTX           !" 基本リスタート・ファイルの書き込み
     I         ( GAU   , GAV   , GAT   , GAPS  , GAQ   ,
     I           GBU   , GBV   , GBT   , GBPS  , GBQ   ,
     I           ITA   , ITB   , IDATEA, IDATEB, ISTEP ,
     I           JFLRST, HDFMT                            )
*
      CALL YFINE
*
      STOP
      END
**********************************************************************
      SUBROUTINE INISET        !" 初期値設定
     O        ( GAU   , GAV   , GAT   , GAPS  , GAQ   ,
     I          SIG                                    )
*
*
*   [PARAM] 
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数, 波数
#else
#include        "zcdim.F"                    !" 格子点数, 波数
#endif
*
*   [OUTPUT] 
      REAL       GAU   ( IDIM, JDIM, KMAX ),
     &           GAV   ( IDIM, JDIM, KMAX ),
     &           GAT   ( IDIM, JDIM, KMAX ),
     &           GAPS  ( IDIM, JDIM       )
      REAL       GAQ   ( IDIM, JDIM, KMAX )
      REAL       SIG   ( KMAX )
*
*   [INTERNAL PARM] 
      REAL       TPRTRB
      DATA       TPRTRB       / 0.1 /
*
*   [INTERNAL WORK] 
      REAL       RANDOM( IDIM, JDIM, KMAX )
      REAL       T
      INTEGER    I, J, K
*
*
      CALL RESET ( GAU   , IDIM*JDIM*KMAX )
      CALL RESET ( GAV   , IDIM*JDIM*KMAX )
c$$$      CALL RESET ( GAT   , IDIM*JDIM*KMAX )
c$$$      CALL RESET ( GAQ   , IDIM*JDIM*KMAX )
      CALL RESET ( GAPS  , IDIM*JDIM      )
*
*
*" << INIT : これが初期値だ >> 
*
c$$$      write (6,*) ' THE VALUE OF TEMPERATURE?'
c$$$      read  (5,*) T
*
      DO 1000 K = 1, KMAX
        DO 1000 J = 1, JDIM
          DO 1000 I = 1, IDIM
            GAU  ( I,J,K ) = 0.
            GAV  ( I,J,K ) = 0.
c$$$           GAT  ( 1,1,1 ) = 280.0
c$$$           GAQ  ( I,1,1 ) = 0.001
 1000 CONTINUE
*
      DO 1100 J = 1, JDIM
         DO 1100 I = 1, IDIM
            GAT(I,J,1)  = 2.99827E+02
            GAT(I,J,2)  = 2.99301E+02
            GAT(I,J,3)  = 2.98223E+02
            GAT(I,J,4)  = 2.96336E+02
            GAT(I,J,5)  = 2.93478E+02
            GAT(I,J,6)  = 2.89588E+02
            GAT(I,J,7)  = 2.84532E+02
            GAT(I,J,8)  = 2.78045E+02
            GAT(I,J,9)  = 2.70147E+02
            GAT(I,J,10) = 2.60697E+02
            GAT(I,J,11) = 2.49096E+02
            GAT(I,J,12) = 2.41673E+02
            GAT(I,J,13) = 2.41089E+02
            GAT(I,J,14) = 2.40554E+02
            GAT(I,J,15) = 2.40016E+02
            GAT(I,J,16) = 2.39612E+02
            GAT(I,J,17) = 2.39410E+02
            GAT(I,J,18) = 2.39307E+02
            GAT(I,J,19) = 2.39255E+02
            GAT(I,J,20) = 2.39229E+02
            GAT(I,J,21) = 2.39215E+02
            GAT(I,J,22) = 2.39208E+02
            GAT(I,J,23) = 2.39205E+02
            GAT(I,J,24) = 2.39203E+02
            GAT(I,J,25) = 2.39202E+02
            GAT(I,J,26) = 2.39202E+02
            GAT(I,J,27) = 2.39201E+02
            GAT(I,J,28) = 2.39201E+02
            GAT(I,J,29) = 2.39201E+02
            GAT(I,J,30) = 2.39201E+02
            GAT(I,J,31) = 2.39201E+02
            GAT(I,J,32) = 2.39201E+02
*
            GAQ(I,J,1)  = 3.36925E-02
            GAQ(I,J,2)  = 3.31725E-02
            GAQ(I,J,3)  = 3.21182E-02
            GAQ(I,J,4)  = 3.03090E-02
            GAQ(I,J,5)  = 2.76603E-02
            GAQ(I,J,6)  = 2.42367E-02
            GAQ(I,J,7)  = 2.01335E-02
            GAQ(I,J,8)  = 1.54733E-02
            GAQ(I,J,9)  = 1.07710E-02
            GAQ(I,J,10) = 6.54852E-03
            GAQ(I,J,11) = 3.21583E-03
            GAQ(I,J,12) = 1.15219E-03
            GAQ(I,J,13) = 1.15219E-03
            GAQ(I,J,14) = 1.15219E-03
            GAQ(I,J,15) = 1.15219E-03
            GAQ(I,J,16) = 1.15219E-03
            GAQ(I,J,17) = 1.15219E-03
            GAQ(I,J,18) = 1.15219E-03
            GAQ(I,J,19) = 1.15219E-03
            GAQ(I,J,20) = 1.15219E-03
            GAQ(I,J,21) = 1.15219E-03
            GAQ(I,J,22) = 1.15219E-03
            GAQ(I,J,23) = 1.15219E-03
            GAQ(I,J,24) = 1.15219E-03
            GAQ(I,J,25) = 1.15219E-03
            GAQ(I,J,26) = 1.15219E-03
            GAQ(I,J,27) = 1.15219E-03
            GAQ(I,J,28) = 1.15219E-03
            GAQ(I,J,29) = 1.15219E-03
            GAQ(I,J,30) = 1.15219E-03
            GAQ(I,J,31) = 1.15219E-03
            GAQ(I,J,32) = 1.15219E-03
 1100 CONTINUE
*
      DO 2000 J = 1, JDIM
        DO 2000 I = 1, IDIM
            GAPS ( I,J   ) = 1000.
 2000 CONTINUE
*
*" << RANDOM : 乱数の付加 >> 
*
c$$$CCC   CALL \SGU1M( IDIM*JDIM*KMAX, 0, RANDOM, IER )
c$$$      DO 3000 K = 1, KMAX
c$$$         DO 3000 J = 1, JDIM
c$$$            DO 3000 I = 1, IDIM
c$$$               RANDOM( I,J,K )
c$$$     &         =  SIN(  REAL(I*J*(KMAX-K))
c$$$     &                / REAL(IMAX*JMAX*KMAX)*10. ) + k*0.15
c$$$ 3000 CONTINUE
c$$$*
c$$$      DO 3100 K = 1, KMAX
c$$$         DO 3100 J = 1, JDIM
c$$$            DO 3100 I = 1, IDIM
c$$$               GAT ( I,J,K ) = GAT ( I,J,K )
c$$$     &                       + RANDOM( I,J,K ) * TPRTRB
c$$$ 3100 CONTINUE
*
      RETURN
      END
