!--
!----------------------------------------------------------------------
!     Copyright (c) 2020 SPMDOEL Development Group
!----------------------------------------------------------------------
!表題  wa_wave_base_module
!
!  spml/wa_wave_module_base モジュールは球面上での流体運動を
!  球面調和函数を用いたスペクトル法によって東西 1 波数数値計算するための 
!  モジュール wa_wave_module の下部モジュールであり, スペクトル計算の
!  基本的な Fortran90 関数を提供する. 
!
!  球面上の 1 層モデル用 w_wave_module_base モジュールを
!  多層モデル用に拡張したものであり, 同時に複数個のスペクトルデータ, 
!  格子点データに対する変換が行える.
!
!  内部で ISPACK3 の LXPACK の Fortran サブルーチンを呼んでいる. 
!  スペクトルデータおよび格子点データの格納方法や変換の詳しい計算法に
!  ついては ISPACK3/LXPACK のマニュアルを参照されたい.
!
!  このモジュールを使うためには前もって w_base_initial を呼んで
!  切断波数, 格子点数の設定をしておく必要がある. 
!
!
!履歴
!      2020/11/24  竹広真一  wa_wave_base_module_svpack より改造
!
!++
module wa_wave_module_base
  !
  != wa_wave_module_base
  !

  !== 概要
  !
  !  spml/wa_wave_module_base モジュールは球面上での流体運動を
  !  球面調和函数を用いたスペクトル法によって東西 1 波数数値計算するための 
  !  モジュール wa_wave_module の下部モジュールであり, スペクトル計算の
  !  基本的な Fortran90 関数を提供する. 
  !
  !  球面上の 1 層モデル用 w_wave_module_base モジュールを
  !  多層モデル用に拡張したものであり, 同時に複数個のスペクトルデータ, 
  !  格子点データに対する変換が行える.
  !
  !  内部で ISPACK3 の LXPACK の Fortran サブルーチンを呼んでいる. 
  !  スペクトルデータおよび格子点データの格納方法や変換の詳しい計算法に
  !  ついては ISPACK3/LXPACK のマニュアルを参照されたい.
  !
  !  このモジュールを使うためには前もって w_base_initial を呼んで
  !  切断波数, 格子点数の設定をしておく必要がある. 
  !
  use dc_message
  use w_wave_module_base, only : im, jm, m, nm=>nn, xy_w, w_xy

  implicit none

  integer               :: km=16         ! 同時に処理する最大データ数(層の数).
                                         ! SNPACK 用ルーチンとの互換性のため.
                                         ! wa_base_module では
                                         ! このパラメタによる制限がない.

  private

  public km                                    ! 層数
  public wa_base_Initial                       ! 初期化サブルーチン
  public wa_base_Finalize                      ! 終了処理

  public xya_wa, wa_xya                        ! 変換関数

  save km                                      ! 最大データ数(層数)を記憶

contains
  !--------------- 初期化 -----------------
  subroutine wa_base_initial(k_in)
    ! 
    ! SNPACK 用 wa_base_initial の互換のためのダミーサブルーチン
    !
    integer,intent(in) :: k_in               !(in) 最大データ数(層数)

    km = k_in

    call MessageNotify('M','wa_base_initial',&
         'No need to set maximum level number and in wa_wave_module_base (2020/11/24) ')

  end subroutine wa_base_Initial

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

  function xya_wa(wa_data,ipow,iflag)    ! 球面調和関数スペクトル -> 格子点
    !
    ! スペクトルデータから格子データへ変換する(多層用).
    !
    real(8), intent(in)   :: wa_data(:,:)
    !(in) スペクトルデータ(2*(nm-m+1))
    !
    real(8)               :: xya_wa(0:im-1,1:jm,size(wa_data,2))
    !(out) 格子点データ(0:im-1,1:jm,:)
    !
    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
    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

    do k=1,size(wa_data,2)
       xya_wa(:,:,k) = xy_w(wa_data(:,k),iflag=ifval,ipow=ipval)
    enddo

  end function xya_wa

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

    real(8)               :: wa_xya(2*(nm-m+1),size(xya_data,3))
    !(out) スペクトルデータ(2*(nm-m+1),:)

    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 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

    do k=1,size(xya_data,3)
       wa_xya(:,k) = w_xy(xya_data(:,:,k),iflag=ifval,ipow=ipval)
    enddo

  end function wa_xya

  !--------------- 終了処理 -----------------
  subroutine wa_base_Finalize
    ! 
    !
    ! このサブルーチンを単独で用いるのでなく, 
    ! 上位サブルーチン wa_Finalize を使用すること.
    !
    call MessageNotify('M','wa_base_finalize',&
         'wa_wave_module_base is finalized (dummy, 2020/11/24) ')

  end subroutine wa_base_Finalize

end module wa_wave_module_base
