!----------------------------------------------------------------------
!     Copyright (c) 2016 Shin-ichi Takehiro. All rights reserved.
!----------------------------------------------------------------------
!表題  w_deriv_mpi_module_supack
!
!  spml/w_deriv_mpi_module_supack モジュールは球面上での 2 次元流体運動を
!  球面調和函数を用いたスペクトル法と MPI によって数値計算するための 
!  モジュール w_mpi_module_supack の下部モジュールであり, スペクトル法の
!  微分計算のための Fortran90 関数を提供する. 
!
!  内部で ISPACK2 の SUPACK の Fortran77 サブルーチンを呼んでいる. 
!  スペクトルデータおよび格子点データの格納方法や変換の詳しい計算法に
!  ついては ISPACK2/SUPACK のマニュアルを参照されたい.
!
!
!履歴  2016/03/13  竹広真一  w_deriv_mpi_module_sjpack を supack 化
!
module w_deriv_mpi_module_supack
  !
  ! w_deriv_mpi_module_supack
  !
  !  spml/w_deriv_mpi_module_supack モジュールは球面上での 2 次元流体運動を
  !  球面調和函数を用いたスペクトル法と MPI によって数値計算するための 
  !  モジュール w_mpi_module_supack の下部モジュールであり, スペクトル法の
  !  微分計算のための Fortran90 関数を提供する. 
  !
  !  内部で ISPACK2 の SUPACK の Fortran77 サブルーチンを呼んでいる. 
  !  スペクトルデータおよび格子点データの格納方法や変換の詳しい計算法に
  !  ついては ISPACK2/SUPACK のマニュアルを参照されたい.
  !
  use dc_message, only : MessageNotify
  use w_base_mpi_module_supack, only : im, jm, nm=>nn, jc=>jl, nc, xv_w, w_xv
  implicit none

  real(8), allocatable  :: D(:)
  ! ラプラシアン演算用配列
  !
  ! スペクトルデータのラプラシアンを計算するための係数
  ! 配列のサイズは(nc*2)
  !

  real(8), allocatable  :: rn(:,:)            
  ! ラプラシアン演算用配列(w_module と互換性を保つため)
  !
  ! スペクトルデータのラプラシアンを計算するための係数
  ! 配列のサイズは(nc, 2)
  !
  ! r(L,1) には L 番目の格納位置のスペクトルに対するラプラシアン計算の
  ! 係数 -n(n+1) の値が格納されている.
  !

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

  private

  public w_deriv_mpi_Initial                  ! 初期化
  public w_deriv_mpi_Finalize                 ! 終了処理

  public w_Lapla_w, w_LaplaInv_w              ! ラプラシアンと逆演算
  public w_DLon_w                             ! 経度微分
  public xv_GradLon_w, xv_GradLat_w           ! 勾配型微分
  public w_DivLon_xv, w_DivLat_xv             ! 発散型微分
  public w_Div_xv_xv                          ! 発散型微分
  public w_JacobianMPI_w_w                    ! ヤコビアン
  public xv_GradLambda_w, xv_GradMu_w         ! 勾配型微分(λ,μ座標)
  public w_DivLambda_xv, w_DivMu_xv           ! 発散型微分(λ,μ座標)

  public rn                                   ! ラプラシアン演算用配列

  save D, rn

contains

  !--------------- 初期化 -----------------
    subroutine w_deriv_mpi_initial
      !
      ! スペクトル微分計算に必要となる作業領域を設定する. 
      !
      ! 他の関数を呼ぶ前に, 最初にこのサブルーチンを呼んで
      ! 初期設定をしなければならない. 
      !
      ! 上位サブルーチン w_mpi_Initial を使用すること.
      !
      allocate(D(nc*2))                      ! ラプラシアン演算用配列
      allocate(rn(nc,2))                     ! ラプラシアン演算用配列

      call suinid(nm,D)

      rn = reshape(D,(/nc,2/))

      w_deriv_initialize=.true.

      call MessageNotify('M','w_deriv_mpi_initial', &
           'w_deriv_mpi_module_supack (2016/03/13)is initialized')

    end subroutine w_deriv_mpi_initial

  !--------------- 微分計算 -----------------
    function w_Lapla_w(w_data)
      !
      ! 入力スペクトルデータにラプラシアン
      !
      !    ▽^2 = 1/cos^2φ・∂^2/∂λ^2 + 1/cosφ・∂/∂φ(cosφ∂/∂φ)
      !
      ! を作用する(1 層用).
      !
      ! スペクトルデータのラプラシアンとは, 対応する格子点データに
      ! ラプラシアンを作用させたデータのスペクトル変換のことである. 
      !
      real(8)              :: w_Lapla_w(nc)
      !(out) 入力スペクトルデータのラプラシアン

      real(8), intent(in)  :: w_data(nc)
      !(in) 入力スペクトルデータ

      call suclap(nm,w_data,w_Lapla_w,D,1)

    end function w_Lapla_w

    function w_LaplaInv_w(w_data)
      !
      ! 入力スペクトルデータに逆ラプラシアン
      !
      !    ▽^{-2}
      !      =[1/cos^2φ・∂^2/∂λ^2 + 1/cosφ・∂/∂φ(cosφ∂/∂φ)]^{-1}
      !
      ! を作用する(1 層用).
      !
      ! スペクトルデータの逆ラプラシアンとは, 対応する格子点データに
      ! 逆ラプラシアンを作用させたデータのスペクトル変換のことである. 
      !
      real(8)              :: w_LaplaInv_w(nc)
      !(out) スペクトルデータの逆ラプラシアン

      real(8), intent(in)  :: w_data(nc)
      !(in) 入力スペクトルデータ

      call suclap(nm,w_data,w_LaplaInv_w,D,2)

    end function w_LaplaInv_w

    function w_DLon_w(w_data)
      !
      ! スペクトルデータに経度微分 ∂/∂λ を作用させる(1 層用).
      !
      ! スペクトルデータの経度微分とは, 対応する格子点データに
      ! 経度微分∂/∂λを作用させたデータのスペクトル変換のことである.
      ! 
      real(8)              :: w_DLon_w(nc)
      !(out) スペクトルデータの経度微分

      real(8), intent(in)  :: w_data(nc)
      !(in) 入力スペクトルデータ

      call sucs2x(nm,w_data,w_DLon_w)

    end function w_DLon_w

    function xv_GradLon_w(w_data)
      !
      ! スペクトルデータに勾配型経度微分 1/cosφ・∂/∂λ を
      ! 作用させた格子点データを返す(1 層用).
      !
      real(8)              :: xv_GradLon_w(0:im-1,jc)
      !(out) スペクトルデータを勾配型経度微分した格子点データ

      real(8), intent(in)  :: w_data(nc)
      !(in) 入力スペクトルデータ

      xv_GradLon_w = xv_w(w_data,ipow=1,iflag=-1)
    end function xv_GradLon_w

    function xv_GradLat_w(w_data)
      !
      ! スペクトルデータに勾配型緯度微分 ∂/∂φ を作用させて
      ! 格子点データに変換して返す(1 層用).
      !
      real(8)              :: xv_GradLat_w(0:im-1,jc)
      !(out) スペクトルデータを勾配型緯度微分した格子点データ

      real(8), intent(in)  :: w_data(nc)
      !(in) 入力スペクトルデータ

      xv_GradLat_w = xv_w(w_data,ipow=1,iflag=1)
    end function xv_GradLat_w

    function w_DivLon_xv(xv_data)
      !
      ! 格子点データに発散型経度微分 1/cosφ・∂/∂λ を作用させて
      ! スペクトルデータに変換して返す(1 層用).
      !
      real(8)              :: w_DivLon_xv(nc)
      !(out) 格子点データを発散型経度微分したスペクトルデータ
      
      real(8), intent(in)  :: xv_data(0:im-1,jc)
      !(in) 入力格子点データ

      w_DivLon_xv = w_xv(xv_data,ipow=1,iflag=-1)
    end function w_DivLon_xv

    function w_DivLat_xv(xv_data)
      !
      ! 格子点データに発散型緯度微分 1/cosφ・∂(f cosφ)/∂φ を作用させて
      ! スペクトルデータに変換して返す(1 層用).
      !
      real(8)              :: w_DivLat_xv(nc)
      !(out) 格子点データを発散型緯度微分したスペクトルデータ

      real(8), intent(in)  :: xv_data(0:im-1,jc)
      !(in) 入力格子点データ

      w_DivLat_xv = w_xv(xv_data,ipow=1,iflag=1)
    end function w_DivLat_xv

    function w_Div_xv_xv(xv_u,xv_v)
      !
      ! 2 つの入力格子点データをベクトル成分とする発散を計算し, 
      ! スペクトルデータとして返す(1 層用).
      !
      real(8)              :: w_Div_xv_xv(nc)
      !(out) 2 つの入力格子点データをベクトル成分とする発散のスペクトルデータ

      real(8), intent(in)  :: xv_u(0:im-1,jc)
      !(in) ベクトル経度成分の格子点データ

      real(8), intent(in)  :: xv_v(0:im-1,jc)
      !(in) ベクトル緯度成分の格子点データ

      w_Div_xv_xv = w_Divlon_xv(xv_u) + w_Divlat_xv(xv_v)
    end function w_Div_xv_xv

    function w_JacobianMPI_w_w(w_a,w_b)
      ! 2 つのスペクトルデータにヤコビアン
      !
      !   J(f,g) = ∂f/∂λ・∂g/∂μ - ∂g/∂λ・∂f/∂μ
      !          = ∂f/∂λ・1/cosφ・∂g/∂φ
      !             - ∂g/∂λ・1/cosφ・∂f/∂φ
      !
      ! を作用させる(1 層用).

      real(8)             :: w_JacobianMPI_w_w(nc)
      !(out) 2 つのスペクトルデータのヤコビアン

      real(8), intent(in) :: w_a(nc)
      !(in) 1つ目の入力スペクトルデータ
      
      real(8), intent(in) :: w_b(nc)
      !(in) 2つ目の入力スペクトルデータ

      w_JacobianMPI_w_w = w_xv( &
                  xv_w(w_DLon_w(w_a))*xv_w(w_b,ipow=2,iflag=1) &
                - xv_w(w_DLon_w(w_b))*xv_w(w_a,ipow=2,iflag=1) )

    end function w_JacobianMPI_w_w

  !--------------- 微分計算 (λ,μ座標系用) -----------------
    function xv_GradLambda_w(w_data)
      !
      ! スペクトルデータに勾配型経度微分 ∂/∂λ を作用する(1 層用).
      !
      real(8)              :: xv_GradLambda_w(0:im-1,jc)
      !(out) スペクトルデータを勾配型経度微分した格子点データ

      real(8), intent(in)  :: w_data(nc)
      !(in) 入力スペクトルデータ
      
      xv_GradLambda_w = xv_w(w_data,ipow=0,iflag=-1)
    end function xv_GradLambda_w

    function xv_GradMu_w(w_data)
      !
      ! スペクトルデータに勾配型緯度微分 (1-μ^2)∂/∂μ  (μ=sinφ)
      ! を作用させて格子点データに変換して返す(1 層用).
      !
      real(8)              :: xv_GradMu_w(0:im-1,jc)
      !(out) スペクトルデータを勾配型緯度微分した格子点データ

      real(8), intent(in)  :: w_data(nc)
      !(in) 入力スペクトルデータ

      xv_GradMu_w = xv_w(w_data,ipow=0,iflag=1)
    end function xv_GradMu_w

    function w_DivLambda_xv(xv_data)
      !
      ! 格子点データに発散型経度微分 1/(1-μ^2)・∂/∂λ (μ=sinφ) 
      ! を作用させてスペクトルデータに変換して返す(1 層用).
      !
      real(8)              :: w_DivLambda_xv(nc)
      !(out) 格子点データを発散型経度微分したスペクトルデータ

      real(8), intent(in)  :: xv_data(0:im-1,jc)
      !(in) 入力格子点データ

      w_DivLambda_xv = w_xv(xv_data,ipow=2,iflag=-1)
    end function w_DivLambda_xv

    function w_DivMu_xv(xv_data)
      !
      ! 格子点データに発散型緯度微分 ∂/∂μ (μ=sinφ)を作用させて
      ! スペクトルデータに変換して返す(1 層用).
      !
      real(8)              :: w_DivMu_xv(nc)
      !(out) 格子点データを発散型緯度微分したスペクトルデータ

      real(8), intent(in)  :: xv_data(0:im-1,jc)
      !(in) 入力格子点データ

      w_DivMu_xv = w_xv(xv_data,ipow=2,iflag=1)
    end function w_DivMu_xv

    subroutine w_deriv_mpi_finalize
      !
      ! モジュールの終了処理(割り付け配列の解放)をおこなう. 
      !
      ! このサブルーチンを単独で用いるのでなく, 
      ! 上位サブルーチン w_mpi_Finalize を使用すること.
      !
      if ( .not. w_deriv_initialize ) then
         call MessageNotify('W','w_deriv_Finalize',&
              'w_deriv_module_supack not initialized yet')
         return
      endif

      deallocate(D)           ! ラプラシアン演算用配列
      deallocate(rn)          ! ラプラシアン演算用配列

      w_deriv_initialize = .false.

      call MessageNotify('M','w_deriv_mpi_Finalize',&
           'w_deriv_mpi_module_supack (2016/03/13) is finalized')

    end subroutine w_deriv_mpi_finalize

end module w_deriv_mpi_module_supack
