* PACKAGE DSPHE  
*
**********************************************************************
      SUBROUTINE W2G     
     M         ( GDATA ,
     I           WDATA ,
     I           HGRAD , HFUNC , KMAXD )
*
*   [PARAM] 




* PACKAGE  ZXT10L32 !" 格子点数，波数 X-Z
*
      INTEGER     IMAX           !" 経度格子数
      INTEGER     JMAX           !" 緯度格子数
      INTEGER     IDIM           !" 経度配列サイズ
      INTEGER     JDIM           !" 緯度配列サイズ
      INTEGER     MMAX           !" 最大東西波数
      INTEGER     LMAX           !" 最大南北波数
      INTEGER     NMAX           !" 最大全波数
      INTEGER     MINT           !" 東西波数間隔
      INTEGER     KMAX           !" 鉛直層数
      INTEGER     KDIM           !" 鉛直配列サイズ
      INTEGER     NMDIM          !" 水平波数成分数
      INTEGER     JMXHF          !" JMAX/2+1
      INTEGER     NWORK          !" ワーク領域大きさ
*
      PARAMETER ( IMAX  = 32,     JMAX =  1,
     &            IDIM  = IMAX+1, JDIM = JMAX,
     &            MMAX  = 10,     LMAX =  0,    NMAX = MMAX, MINT = 1,
     &            KMAX  = 32,     KDIM = KMAX,
     &            NMDIM = (MMAX/MINT+1)*(2*(NMAX+1)-MMAX)
     &                  - (NMAX-LMAX)/MINT*(NMAX-LMAX+1),
     &            JMXHF = JMAX/2+1,
     &            NWORK = IDIM*JDIM*KMAX*12                       )

*
      INTEGER    KMAXD
*
*   [MODIFY] 
      ReaL*8       GDATA ( IDIM*JDIM, KMAXD )  
*
*   [INPUT] 
      ReaL*8       WDATA ( NMDIM, KMAXD    )   
      CHARACTER  HGRAD*4                     
      CHARACTER  HFUNC*4                     
*
*   [INTERNAL ONCE] 
      ReaL*8       PNM   ( JMXHF*NMDIM )       
      ReaL*8       DPNM  ( JMXHF*NMDIM )       
      ReaL*8       TRIGS ( IDIM*2 )            
      INTEGER    IFAX  ( 10 )                
      INTEGER    NMOX  ( 2, 0:MMAX, 0:LMAX ) 
      ReaL*8       GWX   ( JDIM )              
      ReaL*8       GWDEL ( JDIM )              
      LOGICAL    OSET                        
      DATA       OSET / .FALSE. /
      SAVE       PNM   , DPNM  , TRIGS , IFAX
      SAVE       NMOX  , GWX   , GWDEL , OSET
*
*   [INTERNAL WORK] 
      ReaL*8       ZDATA ( IDIM*JDIM, KMAX )   
      ReaL*8       WORK  ( IDIM*JDIM, KMAX )   
*
      ReaL * 8   QSINLA( JDIM )              
      ReaL * 8   QGW   ( JDIM )              
      ReaL*8       ER                          
      INTEGER    NMO   ( 2, 0:MMAX, 0:LMAX ) 
*
      ReaL * 8   QPNM  ( 0:NMAX+1, 0:MMAX )  
      ReaL * 8   QDPNM ( 0:NMAX+1, 0:MMAX )  
*
      INTEGER    J, L, M, NMH
*
      IF ( .NOT. OSET ) THEN
         CALL MSGDMP( 'E','W2G','CONSTANTS ARE NOT SET.')
      ENDIF
*
      IF ( HGRAD(1:1) .EQ. 'Y' ) THEN
         CALL    SPW2G
     M         ( GDATA ,
     I           WDATA ,
     C           DPNM  , NMOX  , TRIGS , IFAX ,
     F           HGRAD , HFUNC ,
     D           IMAX  , JMAX  , KMAXD , IDIM  , JDIM  ,
     D           LMAX  , MMAX  , NMAX  , MINT  , NMDIM , JMXHF ,
     W           ZDATA , WORK                                   )
      ELSE
         CALL    SPW2G
     M         ( GDATA ,
     I           WDATA ,
     C           PNM   , NMOX  , TRIGS , IFAX ,
     F           HGRAD , HFUNC ,
     D           IMAX  , JMAX  , KMAXD , IDIM  , JDIM  ,
     D           LMAX  , MMAX  , NMAX  , MINT  , NMDIM , JMXHF ,
     W           ZDATA , WORK                                   )
      ENDIF
*
      RETURN
*======================================================================
      ENTRY      G2W      
     M         ( WDATA ,
     I           GDATA ,
     I           HGRAD , HFUNC , KMAXD )
*
      IF ( .NOT. OSET ) THEN
         CALL MSGDMP( 'E','G2W','CONSTANTS ARE NOT SET.')
      ENDIF
*
      IF      ( HGRAD(1:1) .EQ. 'Y' ) THEN
         CALL    SPG2W
     M         ( WDATA ,
     I           GDATA ,
     C           DPNM  , NMOX  , TRIGS , IFAX  , GWDEL ,
     F           HGRAD , HFUNC ,
     D           IMAX  , JMAX  , KMAXD , IDIM  , JDIM  ,
     D           LMAX  , MMAX  , NMAX  , MINT  , NMDIM , JMXHF ,
     W           ZDATA , WORK                                   )
      ELSE IF ( HGRAD(1:1) .EQ. 'X' ) THEN
         CALL    SPG2W
     M         ( WDATA ,
     I           GDATA ,
     C           PNM   , NMOX  , TRIGS , IFAX  , GWDEL ,
     F           HGRAD , HFUNC ,
     D           IMAX  , JMAX  , KMAXD , IDIM  , JDIM  ,
     D           LMAX  , MMAX  , NMAX  , MINT  , NMDIM , JMXHF ,
     W           ZDATA , WORK                                   )
      ELSE
         CALL    SPG2W
     M         ( WDATA ,
     I           GDATA ,
     C           PNM   , NMOX  , TRIGS , IFAX  , GWX   ,
     F           HGRAD , HFUNC ,
     D           IMAX  , JMAX  , KMAXD , IDIM  , JDIM  ,
     D           LMAX  , MMAX  , NMAX  , MINT  , NMDIM , JMXHF ,
     W           ZDATA , WORK                                   )
      ENDIF
*
      RETURN
*=====================================================================
      ENTRY      SPSTUP               
     I         ( QSINLA, QGW   , ER    ,
     O           NMO                     )
*
*"         < 1. FFTの準備 >
*
      IF ( IMAX .GE. 2 ) THEN
         CALL RFFTIM
     I         ( IMAX  ,
     O           TRIGS , IFAX )
      ENDIF
*
*"         < 2. ルジャンドル関数の計算 >
*
      IF ( JMAX .GE. 2 ) THEN
         CALL SETPNM
     O         ( PNM   , DPNM  , NMO   ,
     I           QSINLA,
     D           JMAX  , MMAX  , LMAX  , NMAX  , MINT  ,
     D           NMDIM , JMXHF ,
     W           QPNM  , QDPNM                          )
      ELSE
         NMH = 0
         DO 2200 M = 0, MMAX, MINT
            NMH = NMH + 1
            NMO ( 1, M, 0 ) = 2* NMH - 1
            NMO ( 2, M, 0 ) = 2* NMH
 2200    CONTINUE
      ENDIF
*
*
*"         < 3. ガウス荷重 >
*
      DO 3100 J = 1, JMAX
         GWX  ( J ) = QGW( J )
         GWDEL( J ) = QGW( J ) / ER / ( 1. - QSINLA(J)**2 )
 3100 CONTINUE
*
*"         < 4. NMO を コピー >
*
      DO 4100 M = 0, MMAX
         DO 4100 L = 0, LMAX
           NMOX ( 1,M,L ) = NMO ( 1,M,L )
           NMOX ( 2,M,L ) = NMO ( 2,M,L )
 4100 CONTINUE
*
      OSET = .TRUE.
*
      RETURN
      END
