* PACKAGE DS1  !" SMPACK を利用した球面調和関数変換 ( 1 層 )
*
*" [HIS] 98/01/18 (akahori) 新規作成 SMPACK-0.0 対応
*"       98/03/07 (akahori) SMPACK-1.0 対応
*
*=====================================================================
      SUBROUTINE DS1INI     !" 球関数( 1 層)を初期化 
      IMPLICIT NONE

*   [PARAM] 
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数，波数
      INCLUDE   (ZCCOM)                      !" 標準物理定数
#else
#include        "zcdim.F"
#include        "zccom.F"
#endif

! [INTERNAL WORK FOR SMPACK]

      ReaL*8    X   (IMAX)                !" 南北格子点座標値(radian)
      ReaL*8    Y   (JMAX)                !" 東西格子点座標値(radian)
      ReaL*8    W   (JMAX)                !" ガウス荷重
      INTEGER   IT  (5)                   !" SMT???が用いる配列
      ReaL*8    T   (IMAX*2)              !" SMT???が用いる配列
      INTEGER   IP  (2*MMAX+1)            !" SMT???が用いる配列
      ReaL*8    P   ((MMAX+1)*(MMAX+3)*JMAX/2)
                                          !" SMT???が用いる配列
      ReaL*8    QSG (JMAX/2)              !" SMTS2Gが用いる配列
      ReaL*8    QGS (JMAX/2)              !" SMTG2Sが用いる配列
      ReaL*8    QSV (JMAX/2)              !" SMTS?Vが用いる配列
      ReaL*8    QVS (JMAX/2)              !" SMTV?Sが用いる配列
      ReaL*8    QSU (JMAX/2)              !" SMTS?Vが用いる配列
      ReaL*8    QUS (JMAX/2)              !" SMTV?Sが用いる配列
      ReaL*8    R   (MMAX*(MMAX-1)*2)     !" SMTV?S, SMTS?Vが用いる配列
      INTEGER   ML  (NMDIM)               !" 東西波数 m のテーブル
                                          !" SMTV?S, SMTS?Vが用いる
      INTEGER   NL  (NMDIM)               !" 全波数 n のテーブル
      ReaL*8    RF  (NMDIM)               !" SMCLAPが用いる配列
      ReaL*8    RB  (NMDIM)               !" SMCLAPが用いる配列

      SAVE      X,Y,W,IT,T,IP,P
      SAVE      QSG,QGS,QSV,QVS,QSU,QUS
      SAVE      R,ML,NL,RF,RB

! [INPUT or OUTPUT]
      REAL      GDATA( IDIM,JDIM )
      REAL      GDATB( IDIM,JDIM )
      REAL      WDATA( NMDIM )

! [INTERNAL WORK]
      CHARACTER  HFUNC*4

      ReaL*8    WORK ( IDIM*JDIM*3 )      !" ワーク
      ReaL*8    GW   ( JMAX )             !" GW ( ガウス荷重 )
      ReaL*8    Y0   ( JMAX )             !" 東西格子点座標値(radian)

      LOGICAL   OFIRST
      DATA      OFIRST /.TRUE./
      SAVE      OFIRST

!"  < このサブルーチンは一度だけ呼べばよい >

      IF ( .NOT. OFIRST ) RETURN
      WRITE ( 6,* ) ' SMPACK-1.0 FOR 1 LAYER DATE=98/03/03'
      OFIRST = .FALSE.

!"  < 球面調和関数初期化 >

      CALL SMINIT
     I     (MMAX,IMAX,JMAX,1,
     O      X,Y,W,IT,T,IP,P,
     O      QSG,QGS,QSV,QVS,QSU,QUS,
     O      R,ML,NL,RF,RB )

      RETURN

**********************************************************************
      ENTRY DS1G2S            !" 格子→スペクトル
     O         ( WDATA ,
     I           GDATA  )

      CALL SMTG2S
     I     ( MMAX, IMAX, IDIM, JMAX, JDIM, 1,
     I       GDATA,
     O       WDATA, 
     W       WORK,
     I       IT, T, IP, P, QGS ) 

      RETURN

**********************************************************************
      ENTRY DS1S2G            !" スペクトル→格子
     O         ( GDATA ,
     I           WDATA )

      CALL SMTS2G
     I     ( MMAX, IMAX, IDIM, JMAX, JDIM, 1,
     I       WDATA,
     O       GDATA, 
     W       WORK,
     I       IT, T, IP, P, QSG ) 

      RETURN

**********************************************************************
      ENTRY DS1S1V            !" スペクトル→格子(ベクトル)
     O         ( GDATA , GDATB,
     I           WDATA ,
     I           HFUNC         )

      IF ( HFUNC(1:1) .EQ. ' ' ) THEN    !" AGCM5 ではつかっていない

        CALL SMTS1V
     I     ( MMAX, IMAX, IDIM, JMAX, JDIM, 1,
     I       WDATA,
     O       GDATA, GDATB, 
     W       WORK,
     I       IT, T, IP, P, QSV, R, ML ) 

      ELSE

        CALL SMTS1V
     I     ( MMAX, IMAX, IDIM, JMAX, JDIM, 1,
     I       WDATA,
     O       GDATA, GDATB, 
     W       WORK,
     I       IT, T, IP, P, QSU, R, ML ) 

      ENDIF

      RETURN
      END
