!----------------------------------------------------------------------
!     Copyright (c) 2008--2013 Shin-ichi Takehiro. All rights reserved.
!----------------------------------------------------------------------
!表題  wa_base_mpi_module
!
!  spml/wa_base_mpi_module モジュールは球面上での流体運動を
!  球面調和函数を用いたスペクトル法と MPI 並列化によって
!  数値計算するための モジュール wa_mpi_module の下部モジュールであり, 
!  スペクトル計算の基本的な Fortran90 関数を提供する. 
!
!  球面上の 1 層モデル用 w_base_mpi_module モジュールを多層モデル用に
!  拡張したものであり, 同時に複数個のスペクトルデータ, 格子点データに
!  対する変換が行える.
!
!  内部で ISPACK の SPPACK と SNPACK の Fortran77 サブルーチンを呼んでいる. 
!  スペクトルデータおよび格子点データの格納方法や変換の詳しい計算法に
!  ついては ISPACK/SNPACK,SPPACK のマニュアルを参照されたい.
!
!
!履歴  2008/05/26  竹広真一  wa_base_module.f90 を mpi 化
!      2013/02/13  竹広真一  wa_StreamPotential2VectorMPI,  
!                            wa_Vector2VorDivMPI 導入
!      2013/02/15  竹広真一  wa_VectorCosLat2VorDivMPI 導入
!      2013/02/23  竹広真一  wa_base_mpi_Finalize 導入
!
module wa_base_mpi_module
  !
  ! wa_base_mpi_module
  !
  !  spml/wa_base_mpi_module モジュールは球面上での流体運動を
  !  球面調和函数を用いたスペクトル法と MPI 並列化によって
  !  数値計算するための モジュール wa_mpi_module の下部モジュールであり, 
  !  スペクトル計算の基本的な Fortran90 関数を提供する. 
  !
  !  球面上の 1 層モデル用 w_base_mpi_module モジュールを多層モデル用に
  !  拡張したものであり, 同時に複数個のスペクトルデータ, 格子点データに
  !  対する変換が行える.
  !
  !  内部で ISPACK の SPPACK と SNPACK の Fortran77 サブルーチンを呼んでいる. 
  !  スペクトルデータおよび格子点データの格納方法や変換の詳しい計算法に
  !  ついては ISPACK/SNPACK,SPPACK のマニュアルを参照されたい.
  !
  !
  use dc_message
  use w_base_module, only : im, jm, nm
  use w_base_mpi_module, only : id, jd, jc, &
                                it, t, y, ip, p, r, ia, a
  use wa_base_module, only : km
  implicit none

  integer, allocatable  :: ipk(:,:)            ! 変換用配列(多層用)
  real(8), allocatable  :: pk(:,:), rk(:,:)    ! 変換用配列(多層用)

  real(8), allocatable  :: q(:)                ! 作業配列
  real(8), allocatable  :: ww(:), ws(:)        ! 作業配列
  real(8), allocatable  :: w(:)                ! 作業配列

  real(8), allocatable  :: xva_work(:,:,:)     ! wa_xva,xva_wa 変換用配列

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

  real(8), parameter    :: pi=3.14159265358979

  private
  private im, jm, nm                           ! Intel Fortran 対策

  public wa_base_mpi_Initial                   ! 初期化サブルーチン
  public wa_base_mpi_Finalize                  ! 終了処理

  public xva_wa, wa_xva                        ! 変換関数
  public wa_StreamPotential2VectorMPI          ! 流線ポテンシャルから速度場計算
  public wa_Vector2VorDivMPI                   ! 速度場から渦度発散を計算
  public wa_VectorCosLat2VorDivMPI             ! 速度場から渦度発散を計算

  save ipk, pk, rk                             ! 変換用配列を記憶

  save wa_base_initialize                      ! 初期化フラグ

  contains
  !--------------- 初期化 -----------------
    subroutine wa_base_mpi_initial
      ! 
      ! スペクトル変換の最大データ数(層数)を設定する.
      !
      ! このサブルーチンを単独で用いるのでなく, 
      ! 上位サブルーチン wa_Initial を使用すること.
      !
      integer :: iw

      allocate(ipk(km,((nm+1)/2+nm+1)*2))      ! 変換用配列(多層用)
      allocate(pk(km,((nm+1)/2+nm+1)*jm))      ! 変換用配列(多層用)
      allocate(rk(km,((nm+1)/2*2+3)*(nm/2+1))) ! 変換用配列(多層用)

      allocate(q(km*((nm+1)/2+nm+1)*jm))       ! 作業配列(多層用)

      allocate(xva_work(id,jd,km))                ! 変換用配列

      iw=km * max((nm+4)*(nm+3),jd*3*(nm+1),jd*im)

      allocate(ws(iw),ww(iw),w((nm+1)*(nm+1)*km))    ! 作業用配列(多層用)

      call snkini(nm,jm,km,ip,p,r,ipk,pk,rk)

      wa_base_initialize = .true.                    ! 初期化フラグ

      call MessageNotify('M','wa_base_mpi_initial',&
                         'wa_base_mpi_module (2013/02/23) is initialized')

    end subroutine wa_base_mpi_initial

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

    function xva_wa(wa_data,ipow,iflag)    ! 球面調和関数スペクトル -> 格子点
      !
      ! スペクトルデータから格子データへ変換する(多層用).
      !
      real(8), intent(in)   :: wa_data(:,:)
      !(in) スペクトルデータ

      real(8)               :: xva_wa(im,jc,size(wa_data,2))
      !(out) 格子点データ

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

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

      integer, parameter  :: ipow_default  = 0
      integer, parameter  :: iflag_default = 0

      integer ipval, ifval
      integer k

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

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

      k= size(wa_data,2)
      if  ( k > km ) then
         call MessageNotify('E','xva_wa','Size of 3rd dimension invalid.')
      else
         call snts2g(nm,im,id,jc,jd,k,wa_data, xva_work,&
              it,t,y,ipk(1:k,:),pk(1:k,:),rk(1:k,:),ia,a,q,ws,ww,ipval,ifval)
      endif
      xva_wa=xva_work(1:im,1:jc,1:k)

    end function xva_wa

    function wa_xva(xva_data,ipow,iflag) ! 格子点 -> 球面調和関数スペクトル
      !
      ! 格子データからスペクトルデータへ(正)変換する(多層用).
      !
      real(8), intent(in)   :: xva_data(:,:,:)
      !(in) 格子点データ(im,jm,*)

      real(8)               :: wa_xva((nm+1)*(nm+1),size(xva_data,3))
      !(out) スペクトルデータ

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

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

      integer, parameter  :: ipow_default  = 0      ! スイッチデフォルト値
      integer, parameter  :: iflag_default = 0      ! スイッチデフォルト値

      integer ipval, ifval
      integer k

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

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

      k = size(xva_data,3)
      if ( k > km ) then
         call MessageNotify('E','wa_xva','Size of 3rd dimension invalid.')
      endif

      xva_work = 0.0
      xva_work(1:im,1:jc,1:k) = xva_data

      call sntgms(nm,im,id,jc,jd,k,xva_work,wa_xva,&
              it,t,y,ipk(1:k,:),pk(1:k,:),rk(1:k,:),ia,a,q,ws,ww,ipval,ifval,w)

    end function wa_xva

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

    subroutine wa_StreamPotential2VectorMPI(wa_Psi, wa_Chi, xva_U, xva_V)
      !
      ! 流線・ポテンシャル(スペクトルデータ)から速度場(格子データ)に
      ! (逆)変換する(多層用, MPI)
      !
      !   u cosφ =      ∂χ/∂λ - cosφ∂ψ/∂φ, 
      !   v cosφ = cosφ∂χ/∂φ +      ∂ψ/∂λ 
      !
      real(8), intent(in)   :: wa_Psi(:,:)
      !(in) 流線関数(nm+1)*(nm+1)
      real(8), intent(in)   :: wa_Chi(:,:)
      !(in) 速度ポテンシャル(nm+1)*(nm+1)

      real(8), intent(out)   :: xva_U(0:im-1,1:jc,size(wa_Psi,2))
      !(out) 速度経度成分
      real(8), intent(out)   :: xva_V(0:im-1,1:jc,size(wa_Psi,2))
      !(out) 速度緯度成分

      !
      !   u cosφ = ∂χ/∂λ - cosφ∂ψ/∂φ の計算
      !
      xva_U = xva_wa(wa_Chi,ipow=1,iflag=-1) - xva_wa(wa_Psi,ipow=1,iflag=1) 
      !
      !   v cosφ = cosφ∂χ/∂φ + ∂ψ/∂λ の計算
      !
      xva_V = xva_wa(wa_Chi,ipow=1,iflag=1) + xva_wa(wa_Psi,ipow=1,iflag=-1) 

    end subroutine wa_StreamPotential2VectorMPI

    subroutine wa_Vector2VorDivMPI(xva_U, xva_V, wa_Vor, wa_Div)
      !
      ! 速度場(格子データ)から渦度・発散(スペクトルデータ)に
      ! (正)変換する(多層用, MPI)
      ! 
      !   ζ = 1/cosφ∂v/∂λ - 1/cosφ ∂(u cosφ)/∂φ 
      !    D = 1/cosφ∂u/∂λ + 1/cosφ ∂(v cosφ)/∂φ
      !
      real(8), intent(in)   :: xva_U(0:,:,:)
      !(in) 速度経度成分(0:im-1,1:jm)
      real(8), intent(in)   :: xva_V(0:,:,:)
      !(in) 速度緯度成分(0:im-1,1:jm)

      real(8), intent(out)   :: wa_Vor((nm+1)*(nm+1),size(xva_U,3))
      !(out) 流線関数
      real(8), intent(out)   :: wa_Div((nm+1)*(nm+1),size(xva_U,3))
      !(out) 速度ポテンシャル

      !
      !   ζ = 1/cosφ∂v/∂λ - 1/cosφ ∂(u cosφ)/∂φ 
      !
      wa_Vor = wa_xva(xva_V,ipow=1,iflag=-1) - wa_xva(xva_U,ipow=1,iflag=1)
      !
      !    D = 1/cosφ∂u/∂λ + 1/cosφ ∂(v cosφ)/∂φ
      !
      wa_Div = wa_xva(xva_U,ipow=1,iflag=-1) + wa_xva(xva_V,ipow=1,iflag=1)

    end subroutine wa_Vector2VorDivMPI

    subroutine wa_VectorCosLat2VorDivMPI(xva_UCosLat, xva_VCosLat, wa_Vor, wa_Div)
      !
      ! 速度場(格子データ)から渦度・発散(スペクトルデータ)に
      ! (正)変換する(多層用, MPI)
      ! 
      !   ζ = 1/cosφ∂v/∂λ - 1/cosφ ∂(u cosφ)/∂φ 
      !    D = 1/cosφ∂u/∂λ + 1/cosφ ∂(v cosφ)/∂φ
      !
      real(8), intent(in)   :: xva_UCosLat(0:,:,:)
      !(in) 速度経度成分 * cos(lat) (0:im-1,1:jm)
      real(8), intent(in)   :: xva_VCosLat(0:,:,:)
      !(in) 速度緯度成分 * cos(lat) (0:im-1,1:jm)

      real(8), intent(out)   :: wa_Vor((nm+1)*(nm+1),size(xva_UCosLat,3))
      !(out) 流線関数
      real(8), intent(out)   :: wa_Div((nm+1)*(nm+1),size(xva_UCosLat,3))
      !(out) 速度ポテンシャル

      !
      !   ζ = 1/cosφ∂v/∂λ - 1/cosφ ∂(u cosφ)/∂φ 
      !
      wa_Vor =   wa_xva(xva_VCosLat,ipow=2,iflag=-1) &
               - wa_xva(xva_UCosLat,ipow=2,iflag=1)
      !
      !    D = 1/cosφ∂u/∂λ + 1/cosφ ∂(v cosφ)/∂φ
      !
      wa_Div =   wa_xva(xva_UCosLat,ipow=2,iflag=-1) &
               + wa_xva(xva_VCosLat,ipow=2,iflag=1)

    end subroutine wa_VectorCosLat2VorDivMPI

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

      deallocate(ipk)      ! 変換用配列(多層用)
      deallocate(pk)       ! 変換用配列(多層用)
      deallocate(rk)       ! 変換用配列(多層用)

      deallocate(q)        ! 作業配列(多層用)
      deallocate(xva_work) ! 変換用配列
      deallocate(ws,ww,w)  ! 作業用配列(多層用)

      wa_base_initialize = .false. ! 初期化フラグ

      call MessageNotify('M','wa_base_mpi_finalize',&
           'wa_base_mpi_module (2013/02/23) is finalized')

    end subroutine wa_base_mpi_Finalize

end module wa_base_mpi_module
