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

  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(nm+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, 2024/02/17) ')

  end subroutine wa_base_Finalize

end module wa_zonal_module_base