*" PACKAGE XMKINIT  !" 初期値作成 ( 1 time level )
*
*"  [HIS] 92/09/30(takepiro)
*
***********************************************************************
      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, 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)
*
*   [INTERNAL PARM] 
      INTEGER    ISTEP                 !" 通しステップ数
      INTEGER    ITA                   !" 通し時間(t)
      INTEGER    IDATEA( 6 )           !" 時刻：年月日時分秒
*"       : 時刻等
*
      DATA       ITA          / 0 /
      DATA       IDATEA       / 1990, 1, 1, 0, 0, 0 /
      DATA       ISTEP        / 0  /
*
      NAMELIST  /NMDATE/ ITA, ISTEP
*
      CHARACTER  HDSET *(NCC)
      CHARACTER  HFILE *(NFILN)
      CHARACTER  HDFMT *(NCC)
c$$$      DATA       HDFMT  / 'UR8' /
      DATA       HDFMT  / 'UR4' /
      INTEGER    JFLRST 
      DATA       JFLRST / 41 /
*
*   [INTERNAL WORK] 
      REAL       ALAT  ( JDIM )        !" 緯度
      REAL       DLAT  ( JDIM )        !" 緯度荷重
      REAL       ALON  ( IDIM )        !" 経度
      REAL       DLON  ( IDIM )        !" 経度荷重
      REAL       ARAD  ( 0:KDIM )        !" ｒレベル(整数)
      REAL       DRAD  ( 0:KDIM )        !" Δｒ(整数)
*
c$$$      DATA       ERI, ERO, ETA / 0.4, 1.0, 0.4/
*
      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 )
*
      CALL GTCSET( 'DDSET' , HDSET     )
*
      CALL SETCOR
     O         ( ALON  , DLON  ,
     O           ALAT  , DLAT  ,
     O           ARAD  , DRAD    )
*
      CALL INISET               !" 初期値設定
     O         ( GAU   , GAV   , GAW   , GAT   , 
     O           GATOR , GAPOR , 
     I           ALON  , ALAT  , ARAD              )
*
*
      CALL WRRSTX           !" 基本リスタート・ファイルの書き込み
     I         ( GAU   , GAV   , GAW   , GAT   , 
     I           ITA   , IDATEA, ISTEP ,
     I           JFLRST, HDFMT                )
*
      CALL WRRSTY     !" ポテンシャルリスタート・ファイルの書き込み
     I         ( GATOR , GAPOR ,
     I           ITA   , IDATEA, ISTEP ,
     I           JFLRST, HDFMT                )
      CALL YFINE
*
      STOP
      END
**********************************************************************
      SUBROUTINE INISET        !" 初期値設定
     O        ( GAU   , GAV   , GAW   , GAT   , 
     O          GATOR , GAPOR , 
     I          ALON  , ALAT  , ARAD               )
*
*
*   [PARAM] 
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数, 波数
      INCLUDE   (ZCCOM)                      !" 標準物理定数
#else
#include        "zcdim.F"                    !" 格子点数, 波数
#include        "zccom.F"                    !" 標準物理定数
#endif
*
*   [OUTPUT] 
      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 )  !" ポロイダル Φ
      REAL       ALON  ( IDIM )
      REAL       ALAT  ( JDIM )
      REAL       ARAD  ( 0:KDIM )
*
*   [INTERNAL PARM] 
      REAL       TPRTRB
      DATA       TPRTRB       / 0.1 /
      LOGICAL    ORANDM
      DATA       ORANDM       / .FALSE. /
c$$$      DATA       ORANDM       / .TRUE. /
*
      REAL       GATTOP, GATBTM          !" 上面, 下面温度
      DATA       GATTOP, GATBTM  / 0.,  1. /
*
      REAL       PI, XSI
*
*   [INTERNAL WORK] 
      REAL       RANDOM( IDIM, JDIM, 0:KDIM )
      INTEGER    I, J, K
*
      PI = 4 * ATAN( 1.0D0 )
*
      CALL RESET ( GAU   , IDIM*JDIM*KMAX )
      CALL RESET ( GAV   , IDIM*JDIM*KMAX )
      CALL RESET ( GAW   , IDIM*JDIM*KMAX )
      CALL RESET ( GAT   , IDIM*JDIM*KMAX )
      CALL RESET ( GATOR , IDIM*JDIM*KMAX )
      CALL RESET ( GAPOR , IDIM*JDIM*KMAX )
*
*" << INIT : これが初期値だ >> 
*
      DO 1000 K = 0, KDIM
        DO 1000 J = 1, JDIM
          DO 1000 I = 1, IDIM
c$$$            GAU  ( I,J,K ) = 0.
c$$$            GAU  ( I,J,K ) = ARAD(K) * COS( ALAT(J) )
c$$$            GAV  ( I,J,K ) = 0.
c$$$            GAW  ( I,J,K ) = 0.
c$$$            GAT  ( I,J,K ) = 0.
c$$$            GAT  ( I,J,K ) = EXP( - 2 
c$$$     &                            * (  ( ARAD(K) - 0.5 )**2 / 0.01
c$$$     &                                + ALAT(J) **2 / (PI/6)**2
c$$$     &                                + ( ALON(I)-PI )**2 / (PI/6)**2
c$$$     &                               ) )
c$$$            GAT  ( I,J,K ) = GATBTM + 
c$$$     &                        ( ARAD(K) - ERI ) / ( ERO - ERI ) 
c$$$     &                      * ( GATTOP - GATBTM )
c$$$            GATOR ( I,J,K ) = ARAD( K ) * SIN ( ALAT( J ) ) !" 剛体回転
c$$$            GATOR ( I,J,K ) = ARAD( K )                  !" Y_11
c$$$     &                        * COS ( ALAT( J ) ) 
c$$$     &                        * SIN( ALON( I ) ) 
c$$$            GATOR ( I,J,K ) = ARAD( K )                  !" Y_21
c$$$     &                        * 3 * COS ( ALAT( J ) )**2
c$$$     &                        * SIN( 2*ALON( I ) ) 
c$$$            GATOR ( I,J,K ) = ARAD( K )                  !" Y_20
c$$$     &                        * ( 3*SIN( 2*ALAT( J ) ) -1 )/4
c$$$            GATOR ( I,J,K ) = 0.
c$$$            GAPOR ( I,J,K ) = 
c$$$     &                COS ( ALAT( J ) ) * ARAD ( K )
c$$$            XSI  = ( ARAD(K) - ERI )/(ERO-ERI)*PI
c$$$            GAPOR ( I,J,K ) = SIN( XSI ) * SIN( ALAT(J) )
c$$$            GAPOR ( I,J,K ) = 0.
 1000 CONTINUE
*
c$$$      GAT ( 16, 8, 3 ) = 1.0        !" t10l05    用
c$$$      GAT ( 16, 9, 6 ) = 1.0        !" t10l12    用
c$$$      GAT ( 1, 8, 6 ) = 1.0         !" t10l12-yz 用
c$$$      GAPOR ( 1, 8, 6 ) = 1.0       !" t10l12-yz 用
c$$$      GAT ( 32, 16, 3 ) = 1.0        !" t21l05    用
c$$$      GAT ( 64, 32, 3 ) = 1.0        !" t42l05    用
c$$$      GAT ( 1, 16, 6 ) = 1.0        !" t21l12-yz 用
c$$$      GAT ( 1, 16, 6 ) = 1.0        !" t21l12-yz 用
c$$$      GAT ( 16, 1, 6 ) = 1.0        !" t10l12-xz 用
c$$$      GAT ( 1, 1, 8 ) = 1.0         !" v00l16 用
c$$$      GAPOR ( 1, 1, 8 ) = 1.0       !" v00l16 用
*
*" << RANDOM : 乱数の付加 >> 
*
CCC   CALL \SGU1M( IDIM*JDIM*KMAX, 0, RANDOM, IER )
*
      IF ( ORANDM ) THEN
*
         DO 3000 K = 0, KDIM
            DO 3000 J = 1, JDIM
               DO 3000 I = 1, IDIM
                  RANDOM( I,J,K )
     &                 =  SIN(  REAL(I*J*(KMAX-K))
     &                       / REAL(IMAX*JMAX*KMAX)*10. )
 3000    CONTINUE
*
         DO 3100 K = 1, KDIM
            DO 3100 J = 1, JDIM
               DO 3100 I = 1, IDIM
                  GAT ( I,J,K ) = GAT ( I,J,K )
     &                 + RANDOM( I,J,K ) * TPRTRB
 3100    CONTINUE
*
      ENDIF
*
      RETURN
      END
