!--
!-------------------------------------------------------------------------
! Copyright (c) 2019 SPMODEL Development Group. All rights reserved.  
!-------------------------------------------------------------------------
!表題  w_base_module_sxpack
!
!  spml/w_base_module_sxpack モジュールは球面上での 2 次元流体運動を球面調和函
!  数を用いたスペクトル法によって数値計算するためのモジュール w_module_sxpack
!  の下部モジュールであり, スペクトル計算の基本的な Fortran90 関数を提
!  供する.
!
!  内部で ISPACK の SXPACK と Fortran77 サブルーチンを呼んでいる.
!  スペクトルデータおよび格子点データの格納方法や変換の詳しい計算
!  法については ISPACK/SNPACK,SPPACK のマニュアルを参照されたい.
!
!== 履歴
!
!      2019/03/13  竹広真一
!
!++
module w_base_module_sxpack
  !
  != w_base_module_sxpack
  !
  ! Authors:: Shin-ichi Takehiro, Youhei SASAKI
  ! Version:: $Id$
  ! Copyright&License:: See COPYRIGHT[link:../COPYRIGHT]
  !
  !== 概要.
  !
  ! spml/w_base_module_sxpack モジュールは球面上での 2 次元流体運動を
  ! 球面調和函数を用いたスペクトル法によって数値計算するための
  ! モジュール w_module_sxpack の下部モジュールであり, スペクトル法の
  ! 基本的な Fortran90 関数を提供する.
  !
  ! 内部で ISPACK の SXPACK の Fortran77 サブルーチンを呼んでいる.
  ! スペクトルデータおよび格子点データの格納方法や変換の詳しい計算法に
  ! ついては ISPACK/SNPACK,SPPACK のマニュアルを参照されたい.
  !
  use dc_message
  use iso_c_binding

  implicit none

  integer(8)               :: im=64            ! 格子点の設定(東西)
  integer(8)               :: jm=32            ! 格子点の設定(南北)

  integer(8)               :: mm               ! m の切断波数
  integer(8)               :: nn               ! n の切断波数
  integer(8)               :: nm               ! n の最大値
  integer(8)               :: ig=1             ! グリッド種類

  integer(8), allocatable  :: it(:)            ! 変換用配列
  integer(8), allocatable  :: jc(:)            ! 変換用配列
  real(8), allocatable     :: t(:)             ! 変換用配列
  real(8), allocatable     :: r(:)             ! 変換用配列

  real(8), pointer         :: p(:,:)           ! 変換用配列
  real(8), pointer         :: w(:),g(:)        ! 変換用配列
  real(8), pointer         :: g1(:),g2(:)      ! 変換用配列
  real(8), pointer         :: ww(:)            ! 変換用配列  
  type(c_ptr)              :: pp               ! 変換用配列
  type(c_ptr)              :: pg,pw            ! 変換用配列  
  type(c_ptr)              :: pww,pg1,pg2      ! 変換用配列

  real(8), allocatable  :: c(:)                ! 作業配列
  
  real(8), allocatable  :: x_Lon(:), y_Lat(:)                ! 緯度経度
  real(8), allocatable  :: x_Lon_Weight(:), y_Lat_Weight(:)  ! 座標重み
  real(8), allocatable  :: xy_Lon(:,:), xy_Lat(:,:)

  logical               :: w_base_initialize=.false.   ! 初期化フラッグ

  real(8), parameter    :: pi=3.1415926535897932385D0

  private

  public im, jm, mm, nm, nn                   ! 格子点数, 切断波数, 半径
  public it, t, p, r, jc                      ! 変換用作業配列
  
  public w_base_Initial                       ! 初期化サブルーチン
  public w_base_Finalize                      ! 終了サブルーチン

  public x_Lon, y_Lat                         ! 格子座標
  public x_Lon_Weight, y_Lat_Weight           ! 格子座標重み
  public xy_Lon, xy_Lat                       ! 格子座標(im,jm)
  public l_nm, nm_l                           ! 波数格納位置
  public xy_w, w_xy                           ! 変換関数  
  public w_StreamPotential2Vector             ! 流線ポテンシャルから速度場計算
  public w_Vector2VorDiv                      ! 速度場から渦度発散を計算
  public w_VectorCosLat2VorDiv                ! 速度場から渦度発散を計算

  interface l_nm
     module procedure l_nm_array00
     module procedure l_nm_array01
     module procedure l_nm_array10
     module procedure l_nm_array11
  end interface

  interface nm_l
     module procedure nm_l_int
     module procedure nm_l_array
  end interface

  save im, jm, mm, nn, nm                ! 格子点数, 切断波数を記憶
  save it, t, p, r, jc, c                ! 変換用配列を記憶
  save w_base_initialize                 ! 初期化フラグ

  contains
  !--------------- 初期化 -----------------
    subroutine w_base_Initial(n_in,i_in,j_in,np_in)
      !
      ! スペクトル変換の格子点数, 波数および OPENMP 使用時の
      ! 最大スレッド数を設定する.
      !
      ! 実際の使用には上位サブルーチン w_Initial を用いること.
      !
      integer,intent(in) :: i_in              !(in) 格子点数(東西)
      integer,intent(in) :: j_in              !(in) 格子点数(南北)
      integer,intent(in) :: n_in              !(in) 切断全波数
      integer,intent(in), optional :: np_in   !(in) OPENMP での最大スレッド数(ダミー)

      integer :: i, j

      ! 三角波数切断
      im = i_in  ; jm = j_in  ; nn = n_in
      mm = nn    ; nm = nn+1

      if ( present(np_in) )then
         call MessageNotify('M','w_base_Initial', &
                 'Optional argnument np is dummy.')
      endif

      allocate(t(im*3/2))
      allocate(it(im/2))
      allocate(r(((mm+1)*(2*nm-mm-1)+1)/4*3+(2*nm-mm)*(mm+1)/2+mm+1))
      allocate(jc(mm*(2*nm-mm-1)/16+mm))
      call mxallc(pp,jm/2*(2*mm+5))      
      call c_f_pointer(pp,p,[jm/2,2*mm+5])
      
      call mxallc(pg,jm*im)
      call mxallc(pw,jm*im)
      call mxallc(pg1,jm*im)
      call mxallc(pg2,jm*im)      
      call mxallc(pww,jm*im*2)
      call c_f_pointer(pg, g, [jm*im])
      call c_f_pointer(pw, w, [jm*im])
      call c_f_pointer(pg1, g1, [jm*im])
      call c_f_pointer(pg2, g2, [jm*im])      
      call c_f_pointer(pww, ww, [jm*im]*2)

      allocate(c((mm+1)*(mm+1)))               ! 変換用配列

      allocate(x_Lon(0:im-1))                  ! 格子点座標格納配列(経度)
      allocate(x_Lon_Weight(0:im-1))
      allocate(xy_Lon(0:im-1,1:jm))
      allocate(y_Lat(1:jm))
      allocate(y_Lat_Weight(1:jm))             ! 格子点座標格納配列
      allocate(xy_Lat(0:im-1,1:jm))            ! 格子点座標格納配列

      call sxini1(mm,nm,im,it,t,r)
      call sxini2(mm,nm,jm,ig,p,r,jc)
      call sxinic(mm,nn,c)

      do i=0,int(im)-1
         x_Lon(i)  = 2*pi/im*i               ! 経度座標
         x_Lon_Weight(i) = 2*pi/im           ! 経度座標重み
      enddo

      do j=1,int(jm)/2
         y_Lat(jm/2+j)   =  asin(p(j,1))        ! 緯度座標
         y_Lat(jm/2-j+1) = -asin(p(j,1))        ! 緯度座標
         y_Lat_Weight(jm/2+j)   = 2*p(j,2)      ! 緯度重み(Gauss grid)
         y_Lat_Weight(jm/2-j+1) = 2*p(j,2)      ! 緯度重み(Gauss grid)
      enddo

      do j=1,int(jm)
         xy_Lon(:,j) = x_Lon
      enddo

      do i=0,int(im)-1
         xy_Lat(i,:) = y_Lat
      enddo

      w_base_initialize = .true.

      call MessageNotify('M','w_base_initial',&
           'w_base_module_sxpack (2019/03/13) is initialized')

    end subroutine w_base_Initial

  !--------------- 基本関数 -----------------

    function l_nm_array00(n,m)
      !
      ! 全波数(n)と東西波数(m)からそのスペクトルデータの格納位置を返す.
      ! 
      ! 引数 n,m がともに整数値の場合, 整数値を返す. 
      !
      integer               :: l_nm_array00   
      !(out) スペクトルデータの格納位置 

      integer, intent(in)   :: n     !(in) 全波数
      integer, intent(in)   :: m     !(in) 帯状波数           

      integer(8)   :: nd     ! 全波数
      integer(8)   :: md     ! 帯状波数           
      integer(8)   :: ld     ! スペクトルデータの格納位置 

      nd = n ; md = m
      call sxnm2l(nn,nd,md,ld)
      l_nm_array00 = ld
      
    end function l_nm_array00

    function l_nm_array01(n,marray)           ! スペクトルデータの格納位置 
      !
      ! 全波数(n)と東西波数(m)からそのスペクトルデータの格納位置を返す.
      ! 
      ! 第 1 引数 n が整数, 第 2 引数 marray が整数 1 次元配列の場合, 
      ! marray と同じ大きさの 1 次元整数配列を返す. 
      !
      integer, intent(in)  :: n               !(in) 全波数
      integer, intent(in)  :: marray(:)       !(in) 帯状波数
      integer              :: l_nm_array01(size(marray))
      !(out) スペクトルデータ位置

      integer              :: i 

      do i=1, size(marray)
         l_nm_array01(i) = l_nm_array00(n,marray(i))
      enddo
    end function l_nm_array01

    function l_nm_array10(narray,m)
      !
      ! 全波数(n)と東西波数(m)からそのスペクトルデータの格納位置を返す.
      ! 
      ! 第 1 引数 narray が整数 1 次元配列, 第 2 引数  m が整数の場合, 
      ! narray と同じ大きさの 1 次元整数配列を返す. 
      !
      integer, intent(in)  :: narray(:)           !(in) 全波数  
      integer, intent(in)  :: m                   !(in) 帯状波数
      integer              :: l_nm_array10(size(narray))
      !(out) スペクトルデータ位置

      integer              :: i 

      do i=1, size(narray)
         l_nm_array10(i) = l_nm_array00(narray(i),m)
      enddo
    end function l_nm_array10

    function l_nm_array11(narray,marray)
      !
      ! 全波数(n)と東西波数(m)からそのスペクトルデータの格納位置を返す.
      ! 
      ! 第 1,2 引数 narray, marray がともに整数 1 次元配列の場合, 
      ! narray, marray と同じ大きさの 1 次元整数配列を返す. 
      ! narray, marray は同じ大きさでなければならない. 
      !
      integer, intent(in)  :: narray(:)          !(in) 全波数  
      integer, intent(in)  :: marray(:)          !(in) 帯状波数
      integer              :: l_nm_array11(size(narray))
      !(out) スペクトルデータ位置

      integer              :: i 

      if ( size(narray) .ne. size(marray) ) then
         call MessageNotify('E','l_nm_array11',&
              'dimensions of input arrays  n and m are different.')
      endif

      do i=1, size(narray)
         l_nm_array11(i) = l_nm_array00(narray(i),marray(i))
      enddo
    end function l_nm_array11

    function nm_l_int(l)
      ! 
      ! スペクトルデータの格納位置(l)から全波数(n)と東西波数(m)を返す.
      !
      ! 引数 l が整数値の場合, 対応する全波数と帯状波数を
      ! 長さ 2 の 1 次元整数値を返す. 
      ! nm_l(1) が全波数, nm_l(2) が帯状波数である. 
      !
      integer               :: nm_l_int(2)  !(out) 全波数, 帯状波数
      integer, intent(in)   :: l            !(in) スペクトルデータの格納位置

      integer(8)            :: ld           ! スペクトルデータの格納位置
      integer(8)            :: nd           ! 全波数
      integer(8)            :: md           ! 帯状波数      

      ld = l
      call sxl2nm(nn,ld,nd,md)
      nm_l_int = (/nd,md/)
      
    end function nm_l_int

    function nm_l_array(larray)
      ! 
      ! スペクトルデータの格納位置(l)から全波数(n)と東西波数(m)を返す.
      !
      ! 引数 larray が整数 1 次元配列の場合, 
      ! larray に対応する n, m を格納した 2 次元整数配列を返す. 
      ! nm_l_array(:,1) が全波数, nm_l_array(:,2) が帯状波数である. 
      !
      integer, intent(in)  :: larray(:)
      !(out) 全波数, 帯状波数

      integer              :: nm_l_array(size(larray),2)
      !(in) スペクトルデータの格納位置

      integer              :: i

      do i=1, size(larray)
         nm_l_array(i,:) = nm_l_int(larray(i))
      enddo
    end function nm_l_array

  !--------------- 基本変換 -----------------

    function xy_w(w_data,ipow,iflag)
      !
      ! スペクトルデータから格子データへ変換する(1 層用).
      !
      real(8)               :: xy_w(0:im-1,1:jm)
      !(out) 格子点データ

      real(8), intent(in)   :: w_data((nn+1)*(nn+1))
      !(in) スペクトルデータ

      integer, intent(in), optional  :: ipow      
      !(in) 作用させる 1/cosφ の次数. 省略時は 0. 

      integer, intent(in), optional  :: iflag
      !(in) 変換の種類
      !    0 : 通常の正変換
      !   -1 : 経度微分を作用させた逆変換
      !    1 : 緯度微分 cosφ・∂/∂φ を作用させた逆変換
      !    2 : sinφを作用させた逆変換
      !    省略時は 0.
      !
      integer, parameter  :: ipow_default  = 0
      integer, parameter  :: iflag_default = 0

      real(8)             :: w_Xdata((mm+1)*(mm+1))
      ! 作業用スペクトルデータ(SXCS2X 出力用)
      real(8)             :: w_Ydata((mm+2)*(mm+2))
      ! 作業用スペクトルデータ(SXCS2Y 出力用)

      integer(8) ipval, ifval

      if ( .not. w_base_initialize ) then
         call MessageNotify('E','xy_w',&
              'w_base_module_sxpack not initialize yet.')
      endif

      if (present(ipow)) then
         ipval = ipow
      else
         ipval = ipow_default
      endif

      if (present(iflag)) then
         ifval = iflag
      else
         ifval = iflag_default
      endif

      if ( ifval==0 ) then
         call sxts2g(mm,nm,nn,im,jm,w_data,g,it,t,p,r,jc,w,ipval)
         xy_w = reshape(g,(/im,jm/))
      else if( ifval==-1 ) then
         call sxcs2x(mm,nn,w_data,w_Xdata)
         call sxts2g(mm,nm,nn,im,jm,w_Xdata,g,it,t,p,r,jc,w,ipval)
         xy_w = reshape(g,(/im,jm/))         
      else if( ifval==1 ) then
         call sxcs2y(mm,nn,w_data,w_Ydata,c)
         call sxts2g(mm,nm,nn+1_8,im,jm,w_Ydata,g,it,t,p,r,jc,w,ipval)
         xy_w = reshape(g,(/im,jm/))
      else if( ifval==2 ) then
         call sxts2g(mm,nm,nn,im,jm,w_data,g,it,t,p,r,jc,w,ipval)
         xy_w = reshape(g,(/im,jm/)) * sin(xy_Lat)
      else
         call MessageNotify('E','xy_w','invalid value of iflag')
      endif
      
    end function xy_w

    function w_xy(xy_data,ipow,iflag)
      !
      ! 格子データからスペクトルデータへ(正)変換する(1 層用).
      !
      real(8)               :: w_xy((nn+1)*(nn+1))
      !(out) スペクトルデータ

      real(8), intent(in)   :: xy_data(0:im-1,1:jm)
      !(in) 格子点データ

      integer, intent(in), optional  :: ipow
      !(in) 変換時に同時に作用させる 1/cosφ の次数. 省略時は 0.

      integer, intent(in), optional  :: iflag
      ! 変換の種類
      !    0 : 通常の正変換
      !   -1 : 経度微分を作用させた正変換 
      !    1 : 緯度微分 1/cosφ・∂(f cos^2φ)/∂φ を作用させた正変換
      !    2 : sinφを作用させた正変換
      !  省略時は 0.
      !
      integer, parameter  :: ipow_default  = 0    ! スイッチデフォルト値
      integer, parameter  :: iflag_default = 0    ! スイッチデフォルト値

      integer(8) ipval, ifval

      real(8)             :: w_Xdata((mm+1)*(mm+1))
      ! 作業用スペクトルデータ(SXCS2X 出力用)
      real(8)             :: w_Ydata((mm+2)*(mm+2))
      ! 作業用スペクトルデータ(SXCY2S 出力用)

      if ( .not. w_base_initialize ) then
         call MessageNotify('E','w_xy',&
              'w_base_module_sxpack not initialize yet.')
      endif

      if (present(ipow)) then
         ipval = ipow
      else
         ipval = ipow_default
      endif

      if (present(iflag)) then
         ifval = iflag
      else
         ifval = iflag_default
      endif

      if ( ifval == 0 ) then
         g = reshape(xy_data,(/im*jm/))
         call sxtg2s(mm,nm,nn,im,jm,w_xy,g,it,t,p,r,jc,w,ipval)
      else if ( ifval == -1 ) then
         g = reshape(xy_data,(/im*jm/))
         call sxtg2s(mm,nm,nn,im,jm,w_Xdata,g,it,t,p,r,jc,w,ipval)
         call sxcs2x(mm,nn,w_Xdata,w_xy)
      else if ( ifval == 1 ) then
         g = reshape(xy_data,(/im*jm/))
         call sxtg2s(mm,nm,nn+1,im,jm,w_Ydata,g,it,t,p,r,jc,w,ipval)
         call sxcy2s(mm,nn,w_Ydata,w_xy,c)
      else if ( ifval == 2 ) then
         g = reshape(xy_data*sin(xy_Lat),(/im*jm/))
         call sxtg2s(mm,nm,nn,im,jm,w_xy,g,it,t,p,r,jc,w,ipval)
      else
         call MessageNotify('E','w_xy','invalid value of iflag')
      endif
      
    end function w_xy

  !----------- 速度, 渦度・発散, 流線・ポテンシャル計算 -------------

    subroutine w_StreamPotential2Vector(w_Psi, w_Chi, xy_U, xy_V)
      !
      ! 流線・ポテンシャル(スペクトルデータ)から速度場(格子データ)に
      ! (逆)変換する(1 層用)
      !
      ! スペクトル変換を用いず微分を計算するために, 変換回数が 2 回ですむ. 
      !
      !   u cosφ =      ∂χ/∂λ - cosφ∂ψ/∂φ, 
      !   v cosφ = cosφ∂χ/∂φ +      ∂ψ/∂λ 
      !
      real(8), intent(in)   :: w_Psi((nn+1)*(nn+1))
      !(in) 流線関数
      real(8), intent(in)   :: w_Chi((nn+1)*(nn+1))
      !(in) 速度ポテンシャル

      real(8), intent(out)   :: xy_U(0:im-1,1:jm)
      !(out) 速度経度成分
      real(8), intent(out)   :: xy_V(0:im-1,1:jm)
      !(out) 速度緯度成分

      real(8)             :: w_Xdata((mm+1)*(mm+1))
      ! 作業用スペクトルデータ(SXCS2X 出力用)
      real(8)             :: w_Ydata((mm+2)*(mm+2))
      ! 作業用スペクトルデータ(SXCS2Y 出力用)
      real(8)             :: w_Rdata1((mm+2)*(mm+2))
      real(8)             :: w_Rdata2((mm+2)*(mm+2))
      ! 作業用スペクトルデータ

      if ( .not. w_base_initialize ) then
         call MessageNotify('E','w_StreamPotential2Vector',&
              'w_base_module_sxpack not initialize yet.')
      endif

      !
      !   u cosφ = ∂χ/∂λ - cosφ∂ψ/∂φ の計算
      !
      call sxcs2x(mm,nn,w_Chi,w_Xdata)
      call sxcs2y(mm,nn,w_Psi,w_Ydata,c)
      call sxcrpk(mm,nn,nm,w_Xdata,w_Rdata1)
      w_Rdata1 = w_Rdata1 - w_Ydata
      !
      !   v cosφ = cosφ∂χ/∂φ + ∂ψ/∂λ の計算
      !
      call sxcs2y(mm,nn,w_Chi,w_Ydata,c)
      call sxcs2x(mm,nn,w_Psi,w_Xdata)
      call sxcrpk(mm,nn,nm,w_Xdata,w_Rdata2)
      w_Rdata2= w_Rdata2 + w_Ydata
      !
      call sxts2v(mm,nm,nm,im,jm,w_Rdata1,w_Rdata2,g1,g2,it,t,p,r,jc,ww,1_8)
      !
      !   u の計算
      !
      xy_U = reshape(g1,(/im,jm/))
      !
      !   v の計算
      !
      xy_V = reshape(g2,(/im,jm/))
      
    end subroutine w_StreamPotential2Vector

    subroutine w_Vector2VorDiv(xy_U, xy_V, w_Vor, w_Div)
      !
      ! 速度場(格子データ)から渦度・発散(スペクトルデータ)に
      ! (正)変換する(1 層用)
      ! 
      ! スペクトル変換を用いず微分を計算するために, 変換回数が 2 回ですむ. 
      !
      !   ζ = 1/cosφ∂v/∂λ - 1/cosφ ∂(u cosφ)/∂φ 
      !    D = 1/cosφ∂u/∂λ + 1/cosφ ∂(v cosφ)/∂φ
      !
      real(8), intent(in)   :: xy_U(0:im-1,1:jm)
      !(in) 速度経度成分
      real(8), intent(in)   :: xy_V(0:im-1,1:jm)
      !(in) 速度緯度成分

      real(8), intent(out)   :: w_Vor((nn+1)*(nn+1))
      !(out) 流線関数
      real(8), intent(out)   :: w_Div((nn+1)*(nn+1))
      !(out) 速度ポテンシャル

      real(8)             :: w_Xdata((mm+1)*(mm+1))
      ! 作業用スペクトルデータ(SXCS2X 出力用)
      real(8)             :: w_Ydata1((mm+2)*(mm+2))
      real(8)             :: w_Ydata2((mm+2)*(mm+2))      
      ! 作業用スペクトルデータ(SXCS2Y 出力用)
      real(8)             :: w_Data1((mm+1)*(mm+1))
      real(8)             :: w_Data2((mm+1)*(mm+1))
      ! 作業用スペクトルデータ

      if ( .not. w_base_initialize ) then
         call MessageNotify('E','w_Vector2VorDiv',&
              'w_base_module_sxpack not initialize yet.')
      endif

      !
      ! 1/cosφ∂u/∂λ, 1/cosφ ∂(u cosφ)/∂φ の計算
      !
      g1 = reshape(xy_U,(/im*jm/))
      g2 = reshape(xy_V,(/im*jm/))
      call sxtv2s(mm,nm,nn+1,im,jm,w_Ydata1,w_Ydata2,g1,g2,it,t,p,r,jc,ww,1_8)

      call sxcrpk(mm,nm,nn,w_Ydata1,w_Xdata)
      call sxcs2x(mm,nn,w_Xdata,w_Div)
      call sxcy2s(mm,nn,w_Ydata2,w_Data2,c)
      !
      ! 1/cosφ∂v/∂λ, 1/cosφ ∂(v cosφ)/∂φ の計算
      !
      call sxcrpk(mm,nm,nn,w_Ydata2,w_Xdata)
      call sxcs2x(mm,nn,w_Xdata,w_Vor)
      call sxcy2s(mm,nn,w_Ydata1,w_Data1,c)
      !
      !  渦度・発散の計算
      !
      !   ζ = 1/cosφ∂v/∂λ - 1/cosφ ∂(u cosφ)/∂φ 
      !    D = 1/cosφ∂u/∂λ + 1/cosφ ∂(v cosφ)/∂φ
      !
      w_Vor = w_Vor - w_Data1
      w_Div = w_Div + w_Data2

    end subroutine w_Vector2VorDiv

    subroutine w_VectorCosLat2VorDiv(xy_UCosLat, xy_VCosLat, w_Vor, w_Div)
      !
      ! 速度場(格子データ)から渦度・発散(スペクトルデータ)に
      ! (正)変換する(1 層用)
      ! 
      ! スペクトル変換を用いず微分を計算するために, 変換回数が 2 回ですむ. 
      !
      !   ζ = 1/cosφ∂v/∂λ - 1/cosφ ∂(u cosφ)/∂φ 
      !    D = 1/cosφ∂u/∂λ + 1/cosφ ∂(v cosφ)/∂φ
      !
      real(8), intent(in)   :: xy_UCosLat(0:im-1,1:jm)
      !(in) 速度経度成分 * cos(lat)
      real(8), intent(in)   :: xy_VCosLat(0:im-1,1:jm)
      !(in) 速度緯度成分 * cos(lat)

      real(8), intent(out)   :: w_Vor((nn+1)*(nn+1))
      !(out) 流線関数
      real(8), intent(out)   :: w_Div((nn+1)*(nn+1))
      !(out) 速度ポテンシャル

      real(8)             :: w_Xdata((mm+1)*(mm+1))
      ! 作業用スペクトルデータ(SXCS2X 出力用)
      real(8)             :: w_Ydata1((mm+2)*(mm+2))
      real(8)             :: w_Ydata2((mm+2)*(mm+2))      
      ! 作業用スペクトルデータ(SXCS2Y 出力用)
      real(8)             :: w_Data1((mm+1)*(mm+1))
      real(8)             :: w_Data2((mm+1)*(mm+1))
      ! 作業用スペクトルデータ

      if ( .not. w_base_initialize ) then
         call MessageNotify('E','w_VectorCosLat2VorDiv',&
              'w_base_module_sxpack not initialize yet.')
      endif
      !
      ! 1/cosφ∂u/∂λ, 1/cosφ ∂(u cosφ)/∂φ の計算
      !
      g1 = reshape(xy_UCosLat,(/im*jm/))
      g2 = reshape(xy_VCosLat,(/im*jm/))
      call sxtv2s(mm,nm,nn+1,im,jm,w_Ydata1,w_Ydata2,g1,g2,it,t,p,r,jc,ww,2_8)

      call sxcrpk(mm,nm,nn,w_Ydata1,w_Xdata)
      call sxcs2x(mm,nn,w_Xdata,w_Div)
      call sxcy2s(mm,nn,w_Ydata2,w_Data2,c)
      !
      ! 1/cosφ∂v/∂λ, 1/cosφ ∂(v cosφ)/∂φ の計算
      !
      call sxcrpk(mm,nm,nn,w_Ydata2,w_Xdata)
      call sxcs2x(mm,nn,w_Xdata,w_Vor)
      call sxcy2s(mm,nn,w_Ydata1,w_Data1,c)
      !
      !  渦度・発散の計算
      !
      !   ζ = 1/cosφ∂v/∂λ - 1/cosφ ∂(u cosφ)/∂φ 
      !    D = 1/cosφ∂u/∂λ + 1/cosφ ∂(v cosφ)/∂φ
      !
      w_Vor = w_Vor - w_Data1
      w_Div = w_Div + w_Data2

    end subroutine w_VectorCosLat2VorDiv

  !--------------- 終了処理 -----------------
    subroutine w_base_Finalize
      !
      ! モジュールの終了処理(割り付け配列の解放)をおこなう. 
      !
      ! 実際の使用には上位サブルーチン w_Finalize を用いること.
      !
      if ( .not. w_base_initialize ) then
         call MessageNotify('W','w_base_Finalize',&
              'w_base_module_sxpack not initialized yet')
         return
      endif

      deallocate(it)        ! 変換用配列
      deallocate(t)         ! 変換用配列      
      deallocate(r)         ! 変換用配列
      deallocate(jc)        ! 変換用配列
      deallocate(c)                  ! 変換用作業配列

      call mxfree(pp)                ! 変換用作業配列
      call mxfree(pg)                ! 変換用作業配列      
      call mxfree(pg1)               ! 変換用作業配列
      call mxfree(pg2)               ! 変換用作業配列      
      call mxfree(pw)                ! 変換用作業配列
      call mxfree(pww)               ! 変換用作業配列      
      
      deallocate(x_Lon)                ! 格子点座標格納配列(経度)
      deallocate(x_Lon_weight)
      deallocate(xy_Lon)
      deallocate(y_Lat)
      deallocate(y_Lat_Weight)         ! 格子点座標格納配列
      deallocate(xy_Lat)               ! 格子点座標格納配列

      w_base_initialize = .false.

      call MessageNotify('M','w_base_Finalize',&
           'w_base_module_sxpack (2019/03/13) is finalized')

    end subroutine w_base_Finalize

  end module w_base_module_sxpack
