* PACKAGE DG2WD  
*
*"  [HIS] 90/08/31(numaguti)
*"        92/05/18(masaaki)       VOR,DIV(LMAX=0) の取扱い変更
*
**********************************************************************
      SUBROUTINE TENG2W         
     O         ( WTVOR , WTDIV , WTT   , WTPI  , WTQ   ,
     I           GTUA  , GTVA  , GTKE  , GTUT  , GTVT  , GTH   ,
     I           GTPI  , GTUQ  , GTVQ  , GTR   ,
     C           FLAPLA                                          )
*
*   [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                       )

*
*   [OUTPUT]
      ReaL*8       WTVOR ( NMDIM, KMAX      )  
      ReaL*8       WTDIV ( NMDIM, KMAX      )  
      ReaL*8       WTT   ( NMDIM, KMAX      )  
      ReaL*8       WTPI  ( NMDIM            )  
      ReaL*8       WTQ   ( NMDIM, KMAX      )  
*
*   [INPUT]
      ReaL*8       GTUA  ( IDIM, JDIM, KMAX )  
      ReaL*8       GTVA  ( IDIM, JDIM, KMAX )  
      ReaL*8       GTKE  ( IDIM, JDIM, KMAX )  
      ReaL*8       GTUT  ( IDIM, JDIM, KMAX )  
      ReaL*8       GTVT  ( IDIM, JDIM, KMAX )  
      ReaL*8       GTH   ( IDIM, JDIM, KMAX )  
      ReaL*8       GTPI  ( IDIM, JDIM       )  
      ReaL*8       GTUQ  ( IDIM, JDIM, KMAX )  
      ReaL*8       GTVQ  ( IDIM, JDIM, KMAX )  
      ReaL*8       GTR   ( IDIM, JDIM, KMAX )  
*
      ReaL*8       FLAPLA( NMDIM )             
*
*   [INTERNAL WORK]
      COMMON    /COMWRK/
     &           GDUU  , GDVV
      ReaL*8       GDUU  ( IDIM*JDIM, KMAX )   
      ReaL*8       GDVV  ( IDIM*JDIM, KMAX )   
      EQUIVALENCE (GDUU, WTKE)
      ReaL*8       WTKE  ( NMDIM     , KMAX )  
*
      INTEGER    K, NM
*
*"         < 1.  渦度 ζ  >
*
*
*"      ( - ∂(ＵＡ)/∂ｙ )
*
      CALL G2W
     O         ( WTVOR ,
     I           GTUA  ,
     I           'YGRA', 'POS ',  KMAX  )
*
*"      (  ∂(ＶＡ)/∂ｘ )
*
      IF ( MMAX .GE. 1 ) THEN
         CALL G2W
     O         ( WTVOR ,
     I           GTVA  ,
     I           'XGRA', 'ADD ', KMAX  )
      ENDIF
*
*"         < 2.  発散 Ｄ  >
*
*"      (  ∂(ＶＡ)/∂ｙ )
*
      CALL G2W
     O         ( WTDIV ,
     I           GTVA  ,
     I           'YGRA', 'NEG ', KMAX )
*
*"      (  ∂(ＵＡ)/∂ｘ )
*
      IF ( MMAX .GE. 1 ) THEN
         CALL G2W
     O         ( WTDIV ,
     I           GTUA  ,
     I           'XGRA', 'ADD ', KMAX )
      ENDIF
*
*"      ( ＫＥ )
*
      CALL G2W
     O         ( WTKE  ,
     I           GTKE  ,
     I           '    ', 'POSO', KMAX )
*
      DO 2000 K = 1 , KMAX
         DO 2000 NM = 1 , NMDIM
*
*"      ( - ∇・∇ Ｅ )
*
            WTDIV ( NM, K ) =  WTDIV ( NM, K )
     &                          - FLAPLA( NM ) * WTKE( NM, K )
*
 2000 CONTINUE
*
*"         < 3. 温度 Ｔ >
*
*"      ( Ｈ )
*
      CALL G2W
     O         ( WTT   ,
     I           GTH   ,
     I           '    ', 'POSO', KMAX )
*
*"      ( - ∂(ＶＴ')/∂ｙ )
*
      IF ( LMAX .GE. 1 ) THEN
         CALL G2W
     O         ( WTT   ,
     I           GTVT  ,
     I           'YGRD', 'ADD ', KMAX )
      ENDIF
*
*"      ( - ∂(ＵＴ')/∂ｘ )
*
      IF ( MMAX .GE. 1 ) THEN
         CALL G2W
     O         ( WTT   ,
     I           GTUT  ,
     I           'XGRD', 'SUB ', KMAX )
      ENDIF
*
*"         < 4. 地表面気圧 π >
*
*"      ( Ｚ )
*
      CALL G2W
     O         ( WTPI  ,
     I           GTPI  ,
     I           '    ', 'POSO',  1  )
*
*
*"         < 5. 比湿 ｑ >
*
*"      ( Ｒ )
*
      CALL G2W
     O         ( WTQ   ,
     I           GTR   ,
     I           '    ', 'POSO', KMAX )
*
*"      ( - ∂(Ｖｑ)/∂ｙ )
*
      IF ( LMAX .GE. 1 ) THEN
         CALL G2W
     O         ( WTQ   ,
     I           GTVQ  ,
     I           'YGRD', 'ADD ', KMAX  )
      ENDIF
*
*"      ( - ∂(Ｕｑ)/∂ｘ )
*
      IF ( MMAX .GE. 1 ) THEN
         CALL G2W
     O         ( WTQ   ,
     I           GTUQ  ,
     I           'XGRD', 'SUB ', KMAX )
      ENDIF
*
      RETURN
      END
***********************************************************************
      SUBROUTINE GD2WD     
     O         ( WDVOR , WDDIV , WDT   , WDPI  , WDQ   ,
     I           GDVOR , GDDIV , GDT   , GDPS  , GDQ    )
*
*   [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                       )

*
*   [OUTPUT]
      ReaL*8       WDVOR ( NMDIM , KMAX     )  
      ReaL*8       WDDIV ( NMDIM , KMAX     )  
      ReaL*8       WDT   ( NMDIM , KMAX     )  
      ReaL*8       WDPI  ( NMDIM            )  
      ReaL*8       WDQ   ( NMDIM , KMAX     )  
*
*   [INPUT]
      ReaL*8       GDVOR ( IDIM*JDIM, KMAX )   
      ReaL*8       GDDIV ( IDIM*JDIM, KMAX )   
      ReaL*8       GDT   ( IDIM*JDIM, KMAX )   
      ReaL*8       GDPS  ( IDIM*JDIM       )   
      ReaL*8       GDQ   ( IDIM*JDIM, KMAX )   
*
*   [INTERNAL WORK]
* g77 が文句をいわないようにするため,
* サブルーチン GUV2DV と COMWRK の大きさを同じにしている
      COMMON    /COMWRK/
     &           GDUU  , GDVV
      EQUIVALENCE (GDUU, GDPI)
      ReaL*8       GDUU  ( IDIM*JDIM, KMAX )   
      ReaL*8       GDVV  ( IDIM*JDIM, KMAX )   
      ReaL*8       GDPI  ( IDIM*JDIM       )   
*
      INTEGER    IJ
*
*"         < 1. 予報変数 ζ,Ｄ,Ｔ, π,ｑ の変換 >
*
      CALL G2W
     O         ( WDVOR ,
     I           GDVOR ,
     I           '    ', 'POS ', KMAX )
*
      CALL G2W
     O         ( WDDIV ,
     I           GDDIV ,
     I           '    ', 'POS ', KMAX )
*
      CALL G2W
     O         ( WDT   ,
     I           GDT   ,
     I           '    ', 'POSO', KMAX )
*
      DO 1300 IJ = 1, IDIM*JDIM
         GDPI ( IJ ) = LOG ( GDPS( IJ ) )
 1300 CONTINUE
*
      CALL G2W
     O         ( WDPI  ,
     I           GDPI  ,
     I           '    ', 'POSO', 1    )
*
      CALL G2W
     O         ( WDQ   ,
     I           GDQ   ,
     I           '    ', 'POSO', KMAX )
*
      RETURN
      END
***********************************************************************
      SUBROUTINE GUV2VD    
     O         ( WDVOR , WDDIV ,
     I           GDU   , GDV   ,
     C           UVFACT         )
*
*   [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                       )

*
*   [OUTPUT]
      ReaL*8       WDVOR ( NMDIM , KMAX     )  
      ReaL*8       WDDIV ( NMDIM , KMAX     )  
*
*   [INPUT]
      ReaL*8       GDU   ( IDIM*JDIM, KMAX )   
      ReaL*8       GDV   ( IDIM*JDIM, KMAX )   
      ReaL*8       UVFACT( IDIM*JDIM )         
*
*   [INTERNAL WORK]
* g77 が文句をいわないようにするため,
* サブルーチン GUV2DV と COMWRK の大きさを同じにしている
      COMMON    /COMWRK/
     &           GDUU  , GDVV
      ReaL*8       GDUU  ( IDIM*JDIM, KMAX )   
      ReaL*8       GDVV  ( IDIM*JDIM, KMAX )   
*
      INTEGER    IJ, K
*
*"         < 1. ζ のスペクトル >
*
      DO 1100 K = 1, KMAX
         DO 1100 IJ = 1, IDIM*JDIM
            GDUU ( IJ, K ) = GDU ( IJ, K ) * UVFACT( IJ )
            GDVV ( IJ, K ) = GDV ( IJ, K ) * UVFACT( IJ )
 1100 CONTINUE
*
      CALL G2W
     O         ( WDVOR ,
     I           GDUU  ,
     I           'YGRA', 'POS ', KMAX )
*
      IF ( MMAX .GE. 1 ) THEN
         CALL G2W
     O         ( WDVOR ,
     I           GDVV  ,
     I           'XGRA', 'ADD ', KMAX )
      ENDIF
*
*"         < 2. Ｄ のスペクトル >
*
      CALL G2W
     O         ( WDDIV ,
     I           GDVV  ,
     F           'YGRA', 'NEG ', KMAX )
*
      IF ( MMAX .GE. 1 ) THEN
         CALL G2W
     O         ( WDDIV ,
     I           GDUU  ,
     F           'XGRA', 'ADD ', KMAX )
      ENDIF
*
      RETURN
      END
