      PROGRAM SETINI
*
*
*"     << 球面非発散バロトロピックモデルの初期値 >>
*
*                                        92/02/22
*
*
#if   HITAC
      INCLUDE   (ZCDIM)
      INCLUDE   (ZCCOM)
      INCLUDE   (ZHDIM)
#elif SX3
      INCLUDE   "zcdim.F"
      INCLUDE   "zccom.F"
      INCLUDE   "zhdim.F"
#else
#include        "zcdim.F"
#include        "zccom.F"
#include        "zhdim.F"
#endif
*
*"     ========== 変数 =========================================
*
*"     ------- 格子点データ ------------------------------------
*
      REAL       GAU   ( IDIM, JDIM, KMAX )  !" 西風  ｕ(t)
      REAL       GAV   ( IDIM, JDIM, KMAX )  !" 南風  ｖ(t)
      REAL       GAVOR ( IDIM, JDIM, KMAX )  !" 渦度  ζ(t)

      REAL       GBU   ( IDIM, JDIM, KMAX )  !" 西風  ｕ(t-Δt)
      REAL       GBV   ( IDIM, JDIM, KMAX )  !" 南風  ｖ(t-Δt)
*
*"     ========= 定数 ==========================================
*
*"     ------ 座標格子定数 -------------------------------------
*
      REAL       ALON  ( IDIM )              !" 経度
      REAL       DLON  ( IDIM )              !" 経度荷重
      REAL       ALAT  ( JDIM )              !" 緯度
      REAL       DLAT  ( JDIM )              !" 緯度荷重
*
*"     ==========  内部変数 ====================================
*
*"     ------- スペクトルデータ --------------------------------
*
      REAL       WDVOR ( NMDIM , KMAX     )  !" 渦度  ζ
*
*"     ======= 内部定数(DSETCで確定) ============================
*
*"     ------ 球関数展開定数 -----------------------------------
*
      INTEGER    NMO   ( 2, 0:MMAX, 0:LMAX ) !" スペクトルの添字順番
      REAL       FLAPLA( NMDIM  )            !" ラプラシアンの係数
      REAL       EDEL  ( NMDIM  )            !" ζ，Ｄ→Ｕ，Ｖ
*
*"     ------ 力学定数 -----------------------------------------
*
      REAL       CORIOL ( IDIM, JDIM )       !" コリオリ係数 ｆ
      REAL       UVFACT ( IDIM, JDIM )       !" u→U のファクター
*
*"     ------ 時間積分定数 -------------------------------------
*
      REAL       DIFV  ( NMDIM  )            !" 運動量水平拡散係数
      REAL       DIFT  ( NMDIM  )            !" 熱，水平拡散係数
*
*"     ------- 時刻変数 ----------------------------------------
*
      INTEGER    IDATEA( 6 ) , IDATEB( 6 )
*
*"     ------ 実験管理パラメーター -----------------------------
*
      CHARACTER  HFLRST *(NFILN)             !" 出力ファイル：再出発
      CHARACTER  HFLGRS *(NFILN)             !" 出力ファイル：地面
      CHARACTER  HDSET  *16
      CHARACTER  HDFMT  *(NCC)
*
      NAMELIST    /NMINTG/ TUNIT , DELT  , INISTP, TFIL
      NAMELIST    /NMTIME/ TUNIT , START , END   , INTRST
      NAMELIST    /NMFILE/ ASTART, ARSTRT, GSTART, GRSTRT, VMISS
*
      DATA       ISTEP        / 0  /
      DATA       ITA, ITB     / 0 , 0 /
      DATA       IDATEA       / 1990, 1, 1, 0, 0, 0 /
      DATA       IDATEB       / 1990, 1, 1, 0, 0, 0 /
      DATA       HFLRST       / '41' /
      DATA       HFLGRS       / ' ' /
      DATA       HDFMT        / 'UR4' /
*
      CALL YPREP
      WRITE( 6, * ) ' DATA NAME(GTOOL3 format) ?'
      READ ( 5,'(A)' ) HDSET
      WRITE( 6, * ) ' OUTPUT FILE ( GLOBAL ) ?'
      READ ( 5,'(A)' ) HFLRST
*
      WRITE( 6, * ) ' STRENGTH OF VORTEX ?'
      READ ( 5, * ) VORC
      WRITE( 6, * ) ' CENTER OF VORTEX IN DEGREE (lat,lon) ? ' 
      READ ( 5, * ) ALAT0, ALON0
      WRITE( 6, * ) ' RADIUS OF VORTEX IN DEGREE '
      READ ( 5, * ) RAD
*
      CALL       PCONST
      CALL       GTCSET( 'DDSET' , HDSET     )
      CALL       GTCSET( 'MYSIGN', 'takehiro'   )
*
*"          < 0. 定数のセット >
*
      CALL       SETCOR
     O         ( ALON  , DLON  ,
     O           ALAT  , DLAT    )
*
      CALL DSETC
     O         ( NMO   , FLAPLA, EDEL  ,
     O           CORIOL, UVFACT, DIFV  , DIFT  ,
     C           ALAT  , DLAT                     )
*
      CALL INIVOR
     O         ( GAVOR,
     I           VORC , ALAT0 , ALON0 , RAD  ,
     C           ALAT  , ALON                )
*
      CALL GD2WD
     O         ( WDVOR ,
     I           GAVOR   )
*
      DO 5100 K = 1, KMAX
         WDVOR( NMO(1,0,0),K ) = 0.
 5100 CONTINUE
*
      CALL GENGD
     O         ( GAU   , GAV   ,
     O           GAVOR ,
     I           WDVOR ,
     C           EDEL  , UVFACT          )
*
      CALL COPY     ( GBU  , GAU  , IDIM*JDIM*KMAX )
      CALL COPY     ( GBV  , GAV  , IDIM*JDIM*KMAX )
      CALL COPY     ( GBVOR, GAVOR, IDIM*JDIM*KMAX )
*
      CALL GWRSTR
     I         ( GAU   , GAV   , GAVOR , 
     I           GBU   , GBV   , GBVOR , 
     I           ITA   , ITB   , IDATEA, IDATEB, ISTEP ,
     C           HFLRST, HDFMT                             )
*
      STOP
      END
**********************************************************************
      SUBROUTINE INIVOR
     O          ( GAVOR ,
     I            VORC  , ALAT0 , ALON0 , RAD  ,
     C            ALAT  , ALON                   )
*
*"           < 初期渦 強度 = VORC ; 中心 = (RIC,RJC) ; 半径 = RAD
*
#if   HITAC
      INCLUDE   (ZCDIM)
#elif SX3
      INCLUDE   "zcdim.F"
#else
#include        "zcdim.F"
#endif
*
      REAL GAVOR ( IDIM , JDIM, KMAX )
      REAL       ALON  ( IDIM )              !" 経度
      REAL       ALAT  ( JDIM )              !" 緯度
*
      PI = ATAN( 1. )*4
      ALAT0 = ALAT0*PI/180.
      ALON0 = ALON0*PI/180.
      RAD   = RAD*PI/180.
*
      CALL RESET ( GAVOR , IDIM*JDIM*KMAX )
*
      DO 100 J = 1 , JDIM
        DO 100 I = 1, IDIM
           DO 100 K = 1, KMAX
              GAVOR ( I,J,K ) = VORC *
     &              EXP( -(   ( ALAT(J) - ALAT0 )**2
     &                    + ( ALON(I) - ALON0 )**2  )/RAD**2 )
  100 CONTINUE
*
      RETURN
      END

