!--
!----------------------------------------------------------------------
! Copyright(c) 2024 SPMDODEL Development Group. All rights reserved.
!----------------------------------------------------------------------
!表題  wt_zonal_module
!
!    spml/wt_zonal_module モジュールは球面上および球殻内での
!    流体運動をスペクトル法によって帯状数値計算するための 
!    Fortran90 関数を提供するものである. 
!
!    水平方向に球面調和函数変換および上下の境界壁を扱うための
!    チェビシェフ変換を用いる場合のスペクトル計算のためのさまざまな
!    関数を提供する. 
!
!    内部で wa_zonal_module, at_module を用いている. 最下部では
!    球面調和変換およびチェビシェフ変換のエンジンとして ISPACK3 の 
!    Fortran サブルーチンを用いている.
!
!   wt_zonal_modulde で提供される関数・サブルーチンは 3 次元
!   球殻内の流体運動を扱う wt_module モジュールで用いられているものと
!   名前およびインターフェースが共通になるように設計してある. 
!   したがって, wt_module を用いて構成された 2 次元モデルを
!   帯状成分のモデルへと改造するには次の手順が必要となる.
!
!      * use 文での wt_module の引用を wt_zonal_module に変更する.
!      * 配列の大きさを経度方向格子点数 im -> 1 に,
!        水平波数を (nm+1)**2 -> nm-m+1 に変更する.
!      * DO 文で水平波数に関してループを回しているところを
!        (nm+1)**2 -> nm-m+1 に変更する.
!      * gtool 出力の次元変数変更する.
!
!   ただし, 帯状成分モデルへの改変については以下の点に留意する必要がある. 
!
!      * 帯状成分ではない場をスペクトル変換しているところは
!        水平スペクトル変換してはいけない.
!      * 非線形項を実空間で計算しているところで他の波数成分が生じないよう
!        留意すること. 
!
!履歴  2024/02/19  竹広真一  wt_wave_module より改造
!
!凡例
!      データ種類と index
!        x : 経度波数(実部, 虚部)   y : 緯度        z : 動径
!        w : 球面調和関数スペクトル
!        t : チェビシェフ関数スペクトル
!        a : 任意の次元
!
!        xyz : 3 次元格子点データ
!        xy  : 水平 2 次元格子点データ
!        yz  : 子午面 2 次元格子点データ
!
!        wz  : 水平スペクトル動径格子点データ
!        wt  : スペクトルデータ
!
!++
module wt_zonal_module
  !
  != wt_zonal_module
  !
  !== 概要
  !
  !    spml/wt_zonal_module モジュールは球面上および球殻内での
  !    流体運動をスペクトル法によって帯状成分数値計算するための 
  !    Fortran90 関数を提供するものである. 
  !
  !    水平方向に球面調和函数変換および上下の境界壁を扱うための
  !    チェビシェフ変換を用いる場合のスペクトル計算のためのさまざまな
  !    関数を提供する. 
  !
  !    内部で wa_zonal_module, at_module を用いている. 最下部では
  !    球面調和変換およびチェビシェフ変換のエンジンとして ISPACK3 の 
  !    Fortran サブルーチンを用いている.
  !
  !   wt_zonal_modulde で提供される関数・サブルーチンは 3 次元
  !   球殻内の流体運動を扱う wt_module モジュールで用いられているものと
  !   名前およびインターフェースが共通になるように設計してある. 
  !   したがって, wt_module を用いて構成された 2 次元モデルを
  !   帯状成分のモデルへと改造するには次の手順が必要となる.
  !
  !      * use 文での wt_module の引用を wt_zonal_module に変更する.
  !      * 配列の大きさを経度方向格子点数 im -> 1 に,
  !        水平波数を (nm+1)**2 -> nm-m+1 に変更する.
  !      * DO 文で水平波数に関してループを回しているところを
  !        (nm+1)**2 -> nm-m+1 に変更する.
  !      * gtool 出力の次元変数変更する.
  !
  !   ただし, 帯状成分モデルへの改変については以下の点に留意する必要がある. 
  !
  !      * 帯状成分ではない場をスペクトル変換しているところは
  !        水平スペクトル変換してはいけない.
  !      * 非線形項を実空間で計算しているところで他の波数成分が生じないよう
  !        留意すること. 
  !
  !== 関数・変数の名前と型について
  !
  !=== 命名法
  !
  ! * 関数名の先頭 (wt_, xyz_, wz_, w_, xy_, x_, y_, z_, a_) は, 
  !   返す値の形を示している.
  !   wt_  :: スペクトルデータ(球面調和函数・チェビシェフ変換)
  !   xyz_ :: 3 次元格子点データ(経度スペクトル(実部虚部・緯度・動径)
  !   wz_  :: 水平スペクトル, 動径格子点データ
  !
  ! * 関数名の間の文字列(DLon, GradLat, GradLat, DivLon, DivLat, Lapla,..)
  !   は, その関数の作用を表している.
  !
  ! * 関数名の最後 (wt_, xyz_, wz_, w_, xy_,  y_, z_, a_) は, 入力変数の
  !   形がスペクトルデータおよび格子点データであることを示している.
  !   _wt      :: スペクトルデータ
  !   _xyz     :: 3 次元格子点データ
  !   _xyz_xyz :: 2 つの3 次元格子点データ, ...
  !
  !=== 各データの種類の説明
  !
  ! * xyz : 3 次元格子点データ(経度スペクトル(実虚部)・緯度・動径)
  !   * 変数の種類と次元は real(8), dimension(0:im-1,1:jm,0:km). 
  !   * im, jm, km はそれぞれ経度, 緯度, 動径座標の格子点数であり, 
  !     サブルーチン wt_Initial にてあらかじめ設定しておく.
  !
  ! * wt : スペクトルデータ
  !   * 変数の種類と次元は real(8), dimension(2*(nm-m+1),0:lm). 
  !   * nm は球面調和函数の最大全波数, m は東西波数, lm はチェビシェフ
  !     多項式の最大次数であり, サブルーチン wt_Initial にてあらかじめ
  !     設定しておく. 
  !   * 水平スペクトルデータの格納のされ方は関数 l_nm, nm_l によって調べる
  !     ことができる.
  !
  ! * wz : 水平スペクトル, 動径格子点データ.
  !   * 変数の種類と次元は real(8), dimension((nm+1)*(nm+1),0:km).
  !
  ! * wt_ で始まる関数が返す値はスペクトルデータに同じ.
  !
  ! * xyz_ で始まる関数が返す値は 3 次元格子点データに同じ.
  !
  ! * wz_ で始まる関数が返す値は水平スペクトル, 動径格子点データに同じ.
  !
  ! * スペクトルデータに対する微分等の作用とは, 対応する格子点データに
  !   微分などを作用させたデータをスペクトル変換したものことである.
  ! 
  !
  !== 変数・手続き群の要約
  !
  !==== 初期化 
  !
  ! wt_Initial :: スペクトル変換の格子点数, 波数, 領域の大きさの設定
  ! 
  !==== 座標変数
  !
  ! y_Lat, z_Rad               :: 格子点座標(緯度, 経度, 動径座標)を
  !                                 格納した1 次元配列
  ! y_Lat_Weight, z_Rad_Weight :: 重み座標を格納した 1 次元配列
  ! xyz_Lat, xyz_Rad           :: 格子点データの経度・緯度・動径座標(X,Y,Z)
  !                                 (格子点データ型 3 次元配列)
  !
  !==== 基本変換
  !
  ! xyz_wt, wt_xyz :: スペクトルデータと 3 次元格子データの間の変換
  !                   (球面調和函数, チェビシェフ変換)
  ! xyz_wz, wz_xyz :: 3 次元格子データと水平スペクトル・動径格子データとの間
  !                   の変換 (球面調和函数)
  ! wz_wt, wt_wz   :: スペクトルデータと水平スペクトル・動径格子データとの間
  !                   の変換 (チェビシェフ変換)
  ! w_xy, xy_w     :: スペクトルデータと 2 次元水平格子データの間の変換
  !                   (球面調和函数変換) 
  ! az_at, at_az   :: 同時に複数個行う (チェビシェフ変換)格子データと
  !                   チェビシェフデータの間の変換を
  ! l_nm, nm_l     :: スペクトルデータの格納位置と全波数・帯状波数の変換 
  !
  !==== 微分
  !
  ! wt_DRad_wt          :: スペクトルデータに動径微分∂/∂r を作用させる
  ! wt_DivRad_wt        :: スペクトルデータに発散型動径微分
  !                        1/r^2 ∂/∂r r^2 = ∂/∂r + 2/r を作用させる
  ! wt_RotRad_wt        :: スペクトルデータに回転型動径微分
  !                        1/r ∂/∂rr = ∂/∂r + 1/r を作用させる
  ! wt_Lapla_wt         :: スペクトルデータにラプラシアンを作用させる
  ! xyz_GradLon_wt      :: スペクトルデータに勾配型経度微分
  !                        1/rcosφ・∂/∂λを作用させる
  ! xyz_GradLat_wt      :: スペクトルデータに勾配型緯度微分
  !                        1/r・∂/∂φを作用させる
  ! wt_DivLon_xyz       :: 格子データに発散型経度微分
  !                        1/rcosφ・∂/∂λを作用させる
  ! wt_DivLat_xyz       :: 格子データに発散型緯度微分
  !                        1/rcosφ・∂(g cosφ)/∂φを作用させる
  ! wt_Div_xyz_xyz_xyz  :: ベクトル成分である 3 つの格子データに
  !                        発散を作用させる
  ! xyz_Div_xyz_xyz_xyz :: ベクトル成分である 3 つの格子データに
  !                        発散を作用させる
  ! xyz_RotLon_wt_wt    :: ベクトル場の回転の経度成分を計算する
  ! xyz_RotLat_wt_wt    :: ベクトル場の回転の緯度成分を計算する
  ! wt_RotRad_xyz_xyz   :: ベクトル場の回転の動径成分を計算する
  !
  !==== トロイダルポロイダル計算用微分
  !
  ! wt_KxRGrad_wt            :: スペクトルデータに
  !                             経度微分 k×r・▽ = ∂/∂λを作用させる
  ! xyz_KGrad_wt             :: スペクトルデータに軸方向微分
  !                             k・▽ = cosφ/r ∂/∂φ + sinφ∂/∂r を
  !                             作用させる
  ! wt_L2_wt                 :: スペクトルデータに 
  !                             L2 演算子 = -水平ラプラシアンを作用させる
  ! wt_L2Inv_wt              :: スペクトルデータに 
  !                             L2 演算子の逆 = -逆水平ラプラシアンを作用させる
  ! wt_QOperator_wt          :: スペクトルデータに
  !                             演算子 Q=(k・▽-1/2(L2 k・▽+ k・▽L2)) を
  !                             作用させる
  ! wt_RadRot_xyz_xyz        :: ベクトル v の渦度と動径ベクトル r の内積
  !                             r・(▽×v) を計算する
  ! wt_RadRotRot_xyz_xyz_xyz :: ベクトルの v の r・(▽×▽×v) を計算する
  ! wt_Potential2Vector      :: トロイダルポロイダルポテンシャルから
  !                             ベクトル場を計算する
  ! wt_Potential2Rotation    :: トロイダルポロイダルポテンシャルで表される
  !                             非発散ベクトル場の回転の各成分を計算する
  !
  !
  !==== 境界値問題
  !
  ! wt_BoundariesTau, wt_BoundariesGrid, wt_Boundaries                   ::
  !     ディリクレ, ノイマン境界条件を適用する(タウ法, 選点法)
  ! wt_TorBoundariesTau, wt_TorBoundariesGrid, wt_TorBoundaries          ::
  !     速度トロイダルポテンシャルの境界条件を適用する(タウ法,選点法) 
  !
  ! wz_LaplaPol2Pol_wz, wt_LaplaPol2PolTau_wt, wt_LaplaPol2PolGrid_wt    ::
  !     速度ポロイダルポテンシャルΦを▽^2Φから求める
  !     (入出力がそれぞれチェビシェフ格子点,チェビシェフ係数)
  ! wt_TorMagBoundariesTau, wt_TorMagBoundariesGrid, wt_TorMagBoundaries ::
  !     磁場トロイダルポテンシャルの境界条件を適用する(タウ法, 選点法)
  !
  ! wt_PolMagBoundariesTau, wt_PolMagBoundariesGrid, wt_PolMagBoundaries ::
  !     磁場トロイダルポテンシャル境界の境界条件を適用する(タウ法, 選点法)
  !
  !
  !==== 補間計算
  !
  ! Interpolate_wt :: スペクトルデータから任意の点の値を補間する. 
  ! 
  use dc_message
  use lumatrix
  use wa_zonal_module
  use at_module, z_RAD => g_X, z_RAD_WEIGHT => g_X_WEIGHT, &
                 at_az => at_ag, az_at => ag_at, &
                 t_z => t_g, z_t => g_t, &
                 t_Dr_t => t_Dx_t, at_Dr_at => at_Dx_at
  implicit none
  private

  public wt_Initial
  public wt_Finalize

  public x_Lon, x_Lon_Weight
  public y_Lat, y_Lat_Weight
  public z_Rad, z_Rad_Weight
  public l_nm, nm_l
  public xy_Lon, xy_Lat
  public xyz_Lon, xyz_Lat, xyz_Rad
  public wz_Rad
  public wt_VMiss

  public w_xy, xy_w
  public at_Dr_at, t_Dr_t, az_at, at_az
  public xyz_wt, wt_xyz, xyz_wz, wz_xyz, wz_wt, wt_wz
  public wt_DRad_wt, wt_DivRad_wt, wt_RotRad_wt, wt_Lapla_wt
  public xyz_GradLon_wt, xyz_gradlat_wt
  public wt_DivLon_xyz, wt_DivLat_xyz
  public wt_Div_xyz_xyz_xyz, xyz_Div_xyz_xyz_xyz
  public xyz_RotLon_wt_wt, xyz_RotLat_wt_wt, wt_RotRad_xyz_xyz

  public wt_KxRGrad_wt, xyz_KGrad_wt, wt_L2_wt, wt_L2Inv_wt, wt_QOperator_wt
  public wt_RadRot_xyz_xyz, wt_RadRotRot_xyz_xyz_xyz
  public wt_Potential2vector, wt_Potential2Rotation

  public wt_Boundaries, wt_TorBoundaries
  public wt_LaplaPol2Pol_wt, wz_LaplaPol2Pol_wz
  public wt_TormagBoundaries, wt_PolmagBoundaries

  public wt_BoundariesTau, wt_TorBoundariesTau, wt_LaplaPol2PolTau_wt
  public wt_TormagBoundariesTau, wt_PolmagBoundariesTau

  public wt_BoundariesGrid, wt_TorBoundariesGrid, wt_LaplaPol2PolGrid_wt
  public wt_TormagBoundariesGrid, wt_PolmagBoundariesGrid

  public Interpolate_wt

  interface wt_Boundaries
     module procedure wt_BoundariesTau
  end interface

  interface wt_TorBoundaries
     module procedure wt_TorBoundariesTau
  end interface

  interface wt_LaplaPol2Pol_wt
     module procedure wt_LaplaPol2PolTau_wt
  end interface

  interface wt_TorMagBoundaries
     module procedure wt_TorMagBoundariesTau
  end interface

  interface wt_PolMagBoundaries
     module procedure wt_PolMagBoundariesTau
  end interface

  integer            :: im=2,  jm=32, km=16  ! 格子点の設定(経度, 緯度, 動径)
  integer            :: nm=21, lm=16         ! 切断波数の設定(水平, 動径)
  real(8)            :: ri=0.0, ro=1.0       ! 球殻内外半径
  real(8), parameter :: pi=3.1415926535897932385D0

  real(8), dimension(:,:,:), allocatable :: xyz_LON, xyz_LAT, xyz_RAD ! 座標
  real(8), dimension(:,:), allocatable   :: wz_RAD                    ! 座標

  real(8) :: wt_VMiss = -999.0        ! 欠損値

  logical :: wt_Initialize = .false.
  ! 初期化スイッチ

  logical :: wt_TorBoundariesTau_first = .true.
  ! 境界条件ルーチン初期化スイッチ

  logical :: wt_TorBoundariesGrid_first = .true.
  ! 境界条件ルーチン初期化スイッチ

  logical :: wz_LaplaPol2Pol_wz_first = .true.
  ! 境界条件ルーチン初期化スイッチ

  logical :: wt_LaplaPol2PolTau_wt_first = .true.
  ! 境界条件ルーチン初期化スイッチ

  logical :: wt_LaplaPol2PolGrid_wt_first = .true.
  ! 境界条件ルーチン初期化スイッチ

  logical :: wt_TormagBoundariesTau_first = .true.
  ! 境界条件ルーチン初期化スイッチ

  logical :: wt_TormagBoundariesGrid_first = .true.
  ! 境界条件ルーチン初期化スイッチ

  logical :: wt_PolmagBoundariesTau_first = .true.
  ! 境界条件ルーチン初期化スイッチ

  logical :: wt_PolmagBoundariesGrid_first = .true.
  ! 境界条件ルーチン初期化スイッチ

  save im, jm, km, nm, lm, ri, ro
  save xyz_Lat, xyz_Rad, wz_Rad
  save wt_Initialize
  save wt_TorBoundariesTau_first
  save wt_TorBoundariesGrid_first
  save wz_LaplaPol2Pol_wz_first
  save wt_LaplaPol2PolTau_wt_first
  save wt_LaplaPol2PolGrid_wt_first
  save wt_TormagBoundariesTau_first
  save wt_TormagBoundariesGrid_first
  save wt_PolmagBoundariesTau_first
  save wt_PolmagBoundariesGrid_first

contains
  !--------------- 初期化 -----------------
  subroutine wt_Initial(i,j,k,n,l,r_in,r_out,np,wa_init)
    !
    ! スペクトル変換の格子点数, 波数, 動径座標の範囲を設定する.
    !
    ! 他の関数を呼ぶ前に, 最初にこのサブルーチンを呼んで初期設定を
    ! しなければならない. 
    !
    ! np に 1 より大きな値を指定すれば ISPACK の球面調和函数変換 
    ! OPENMP 並列計算ルーチンが用いられる. 並列計算を実行するには, 
    ! 実行時に環境変数 OMP_NUM_THREADS を np 以下の数字に設定する等の
    ! システムに応じた準備が必要となる. 
    !
    ! np に 1 より大きな値を指定しなければ並列計算ルーチンは呼ばれない.
    !
    !
    integer,intent(in) :: i              ! 格子点数(経度λ)
    integer,intent(in) :: j              ! 格子点数(緯度φ)
    integer,intent(in) :: k              ! 格子点数(動径 r)
    integer,intent(in) :: n              ! 切断波数(水平全波数)
    integer,intent(in) :: l              ! 切断波数(動径波数)

    real(8),intent(in) :: r_in           ! 球殻内半径
    real(8),intent(in) :: r_out          ! 球殻外半径

    integer,intent(in), optional :: np   ! OPENMP での最大スレッド数
    logical,intent(in), optional :: wa_init   ! wa_initial スイッチ

    logical    :: wa_initialize=.true.   ! wa_initial スイッチ

    im = i  ; jm = j ; km = k
    nm = n  ; lm = l
    ri = r_in ; ro = r_out

    if ( present(wa_init) ) then
       wa_initialize = wa_init
    else
       wa_initialize = .true.
    endif

    if ( wa_initialize ) then
       if ( present(np) ) then
          call MessageNotify &
               ('M','wt_Initial','np is dummy . No need to set np in wt_zonal_module')
       else
          call wa_Initial(nm,im,jm,km+1)
       endif
    endif

    call at_Initial(km,lm,r_in,r_out)

    allocate(xyz_Lon(0:im-1,1:jm,0:km))
    allocate(xyz_Lat(0:im-1,1:jm,0:km))
    allocate(xyz_Rad(0:im-1,1:jm,0:km))

    allocate(wz_Rad(nm+1,0:km))

    xyz_Lon = spread(xy_Lon,3,km+1)
    xyz_Lat = spread(xy_Lat,3,km+1)
    xyz_Rad = spread(spread(z_Rad,1,jm),1,im)

    wz_Rad = spread(z_Rad,1,nm+1)

    z_Rad_Weight = z_Rad_Weight * z_Rad**2       ! r^2 dr の積分重み

    wt_Initialize = .true.

    call MessageNotify('M','wt_initial', &
         'wt_zonal_module (2025/12/10) is initialized')

  end subroutine wt_initial

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

  function xyz_wt(wt)
    !
    ! スペクトルデータから 3 次元格子点データへ(逆)変換する.
    !
    real(8), dimension(nm+1,0:lm), intent(in) :: wt
    !(in) 2 次元球面調和函数チェビシェフスペクトルデータ
    real(8), dimension(0:im-1,1:jm,0:km)               :: xyz_wt
    !(out) 3 次元経度緯度動径格子点データ

    xyz_wt = xya_wa(wz_wt(wt))

  end function xyz_wt

  function wt_xyz(xyz)
    !
    ! 3 次元格子点データからスペクトルデータへ(正)変換する.
    !
    real(8), dimension(0:im-1,1:jm,0:km), intent(in) :: xyz
    !(in) 3 次元経度緯度動径格子点データ
    real(8), dimension(nm+1,0:lm)           :: wt_xyz
    !(out) 2 次元球面調和函数チェビシェフスペクトルデータ

    wt_xyz = wt_wz(wa_xya(xyz))

  end function wt_xyz

  function xyz_wz(wz)
    !
    ! 水平スペクトル・動径格子点データから 3 次元格子点データへ(逆)変換する.
    !
    real(8), dimension(nm+1,0:km), intent(in) :: wz
    !(in) 2 次元球面調和函数スペクトル・動径格子点データ
    real(8), dimension(0:im-1,1:jm,0:km)               :: xyz_wz
    !(out) 3 次元経度緯度動径格子点データ

    xyz_wz = xya_wa(wz)

  end function xyz_wz

  function wz_xyz(xyz)
    !
    ! 3 次元格子データから水平スペクトル・動径格子点データへ(正)変換する.
    !
    real(8), dimension(0:im-1,1:jm,0:km), intent(in)   :: xyz
    !(in) 3 次元経度緯度動径格子点データ
    real(8), dimension(nm+1,0:km)             :: wz_xyz
    !(out) 2 次元球面調和函数スペクトル・動径格子点データ

    wz_xyz = wa_xya(xyz)

  end function wz_xyz

  function wz_wt(wt)
    !
    ! スペクトルデータから水平スペクトル・動径格子点データへ(正)変換する.
    !
    real(8), dimension(nm+1,0:lm), intent(in) :: wt
    !(in) 2 次元球面調和函数チェビシェフスペクトルデータ
    real(8), dimension(nm+1,0:km)             :: wz_wt
    !(out) 2 次元球面調和函数スペクトル・動径格子点データ

    wz_wt = az_at(wt)

  end function wz_wt

  function wt_wz(wz)
    !
    ! 水平スペクトル・動径格子点データからスペクトルデータへ(正)変換する.
    !
    real(8), dimension(nm+1,0:km), intent(in) :: wz
    !(in) 2 次元球面調和函数スペクトル・動径格子点データ
    real(8), dimension(nm+1,0:lm)             :: wt_wz
    !(out) 2 次元球面調和函数チェビシェフスペクトルデータ

    wt_wz = at_az(wz)

  end function wt_wz

  !--------------- 微分計算 -----------------
  function wt_DRad_wt(wt)
    !
    ! 入力スペクトルデータに動径微分 ∂/∂r を作用する.
    !
    ! スペクトルデータの動径微分とは, 対応する格子点データに動径微分を
    ! 作用させたデータのスペクトル変換のことである.
    !
    real(8), dimension(nm+1,0:lm), intent(in) :: wt
    !(in) 2 次元球面調和函数チェビシェフスペクトルデータ

    real(8), dimension(nm+1,0:lm)             :: wt_DRad_wt
    !(in) 動径微分された2 次元球面調和函数チェビシェフスペクトルデータ

    wt_DRad_wt = at_Dr_at(wt)

  end function wt_DRad_wt

  function wt_DivRad_wt(wt)
    ! 
    ! 入力スペクトルデータに発散型動径微分
    !
    !       1/r^2 ∂/∂r (r^2 .)= ∂/∂r + 2/r
    !
    ! を作用する.
    !
    ! スペクトルデータの発散型動径微分とは, 対応する格子点データに
    ! 発散型動径微分を作用させたデータのスペクトル変換のことである. 
    !
    real(8), dimension(nm+1,0:lm), intent(in) :: wt
    !(in) 2 次元球面調和函数チェビシェフスペクトルデータ

    real(8), dimension(nm+1,0:lm)             :: wt_DivRad_wt
    !(out) 発散型動径微分を作用された 2 次元スペクトルデータ

    wt_DivRad_wt = wt_Drad_wt(wt) + wt_wz(2/wz_rad*wz_wt(wt))


  end function wt_DivRad_wt

  function wt_RotRad_wt(wt)
    !
    ! 入力スペクトルデータに回転型動径微分
    !
    !      1/r ∂(r.)/∂r = ∂(.)/∂r + (.)/r
    !
    ! を作用する.
    !
    ! スペクトルデータの回転型動径微分とは, 対応する格子点データに
    ! 回転型動径微分を作用させたデータのスペクトル変換のことである. 
    !
    real(8), dimension(nm+1,0:lm), intent(in) :: wt
    !(in) 2 次元球面調和函数チェビシェフスペクトルデータ

    real(8), dimension(nm+1,0:lm)             :: wt_RotRad_wt
    !(out) 回転型動径微分を作用された 2 次元スペクトルデータ

    wt_RotRad_wt = wt_Drad_wt(wt) + wt_wz(1/wz_Rad*wz_wt(wt))

  end function wt_RotRad_wt

  function wt_Lapla_wt(wt)
    ! 入力スペクトルデータにラプラシアン
    !
    !     ▽^2 =   1/r^2 cos^2φ・∂^2/∂λ^2 
    !            + 1/r^2 cosφ・∂/∂φ(cosφ∂/∂φ) 
    !            + 1/r^2 ∂/∂r (r^2 ∂/∂r) 
    !
    ! を作用する.
    !
    ! スペクトルデータのラプラシアンとは, 対応する格子点データに
    ! ラプラシアンを作用させたデータのスペクトル変換のことである. 
    !
    real(8), dimension(nm+1,0:lm), intent(in) :: wt
    !(in) 2 次元球面調和函数チェビシェフスペクトルデータ

    real(8), dimension(nm+1,0:lm)             :: wt_Lapla_wt
    !(out) ラプラシアンを作用された 2 次元スペクトルデータ

    wt_Lapla_wt = wt_DivRad_wt(wt_Drad_wt(wt)) &
         + wt_wz(wz_wt(wa_Lapla_wa(wt))/wz_Rad**2)

  end function wt_Lapla_wt

  function xyz_GradLon_wt(wt)
    !
    ! スペクトルデータに勾配型経度微分 1/rcosφ・∂/∂λ
    ! を作用させる.
    !
    real(8), dimension(nm+1,0:lm), intent(in) :: wt
    !(in) 2 次元球面調和函数チェビシェフスペクトルデータ

    real(8), dimension(0:im-1,1:jm,0:km)   :: xyz_GradLon_wt
    !(out) 勾配型経度微分を作用された 2 次元スペクトルデータ

    xyz_GradLon_wt = xya_GradLon_wa(wz_wt(wt))/xyz_Rad

  end function xyz_GradLon_wt

  function xyz_GradLat_wt(wt) 
    !
    ! スペクトルデータに勾配型経度微分 1/r ∂/∂φ を作用させる.
    !
    real(8), dimension(nm+1,0:lm), intent(in) :: wt
    !(in) 2 次元球面調和函数チェビシェフスペクトルデータ

    real(8), dimension(0:im-1,1:jm,0:km)    :: xyz_GradLat_wt
    !(out) 勾配型緯度微分を作用された 2 次元スペクトルデータ

    xyz_GradLat_wt = xya_GradLat_wa(wz_wt(wt))/xyz_Rad

  end function xyz_GradLat_wt

  function wt_DivLon_xyz(xyz)
    ! 
    ! 格子点データに発散型経度微分 1/rcosφ・∂/∂λ を作用させた
    ! スペクトルデータを返す.
    !
    real(8), dimension(0:im-1,1:jm,0:km), intent(in)   :: xyz
    !(in) 3 次元経度緯度動径格子点データ
    real(8), dimension(nm+1,0:lm)       :: wt_DivLon_xyz
    !(out) 発散型経度微分を作用された 2 次元スペクトルデータ

    wt_DivLon_xyz = wt_wz(wa_DivLon_xya(xyz/xyz_Rad))

  end function wt_DivLon_xyz

  function wt_DivLat_xyz(xyz)
    !
    ! 格子データに発散型緯度微分 1/rcosφ・∂(f cosφ)/∂φ を
    ! 作用させたスペクトルデータを返す.
    !
    real(8), dimension(0:im-1,1:jm,0:km), intent(in)   :: xyz
    !(in) 3 次元経度緯度動径格子点データ
    real(8), dimension(nm+1,0:lm)       :: wt_DivLat_xyz
    !(out) 発散型緯度微分を作用された 2 次元スペクトルデータ

    wt_DivLat_xyz = wt_wz(wa_divlat_xya(xyz/xyz_Rad))

  end function wt_DivLat_xyz

  function wt_Div_xyz_xyz_xyz(xyz_Vlon,xyz_Vlat,xyz_Vrad)
    !
    ! べクトル成分である 3 つの格子データに発散を作用させた
    ! スペクトルデータを返す.
    !
    ! 第 1, 2 ,3 引数(u,v,w)がそれぞれベクトルの経度成分, 緯度成分, 
    ! 動径成分を表し, 発散は 
    !
    !      1/rcosφ・∂u/∂λ + 1/rcosφ・∂(v cosφ)/∂φ 
    !    + 1/r^2 ∂/∂r (r^2 w)
    !
    ! と計算される.
    !
    real(8), dimension(0:im-1,1:jm,0:km), intent(in) :: xyz_Vlon
    !(in) ベクトル場の経度成分
    real(8), dimension(0:im-1,1:jm,0:km), intent(in) :: xyz_Vlat
    !(in) ベクトル場の緯度成分

    real(8), dimension(0:im-1,1:jm,0:km), intent(in) :: xyz_Vrad
    !(in) ベクトル場の動径成分

    real(8), dimension(nm+1,0:lm)     :: wt_Div_xyz_xyz_xyz
    !(out) ベクトル場の発散

    wt_Div_xyz_xyz_xyz =   wt_DivLon_xyz(xyz_Vlon) &
         + wt_DivLat_xyz(xyz_Vlat) &
         + wt_DivRad_wt(wt_xyz(xyz_Vrad))

  end function wt_Div_xyz_xyz_xyz

  function xyz_Div_xyz_xyz_xyz(xyz_Vlon,xyz_Vlat,xyz_Vrad)
    !
    ! ベクトル成分である 3 つの格子データに発散を作用させる.
    !
    ! 第 1, 2 ,3 引数(u,v,w)がそれぞれベクトルの経度成分, 緯度成分, 
    ! 動径成分を表す.
    !
    ! 極の特異性を回避するためにベクトル場に cosφ/r の重みをかけて
    ! 計算している. 
    !
    !      div V = (r/cosφ)・div (Vcosφ/r) + V_φtanφ/r + V_r/r
    ! 
    real(8), dimension(0:im-1,1:jm,0:km), intent(in) :: xyz_Vlon
    !(in) ベクトル場の経度成分

    real(8), dimension(0:im-1,1:jm,0:km), intent(in) :: xyz_Vlat
    !(in) ベクトル場の緯度成分

    real(8), dimension(0:im-1,1:jm,0:km), intent(in) :: xyz_Vrad
    !(in) ベクトル場の動径成分

    real(8), dimension(0:im-1,1:jm,0:km)             :: xyz_Div_xyz_xyz_xyz
    !(out) ベクトル場の発散

    xyz_Div_xyz_xyz_xyz &
         = xyz_Rad/cos(xyz_Lat) &
         * xyz_wt(wt_Div_xyz_xyz_xyz(xyz_VLon*cos(xyz_Lat)/xyz_Rad,  &
         xyz_VLat*cos(xyz_Lat)/xyz_Rad,  &
         xyz_VRad*cos(xyz_Lat)/xyz_Rad ))&
         + xyz_VLat*tan(xyz_Lat)/xyz_Rad &
         + xyz_VRad/xyz_Rad

  end function xyz_Div_xyz_xyz_xyz

  function xyz_RotLon_wt_wt(wt_Vrad,wt_Vlat) 
    !
    ! ベクトル場の動径成分, 緯度成分である第 1, 2 引数 Vrad, Vlat から
    ! 回転の経度成分 
    !
    !    1/r ∂Vrad/∂φ-1/r ∂(r Vlat)/∂r を計算する.
    !
    ! を計算する
    !
    real(8), dimension(nm+1,0:lm), intent(in) :: wt_Vrad
    !(in) ベクトル場の動径成分

    real(8), dimension(nm+1,0:lm), intent(in) :: wt_Vlat
    !(in) ベクトル場の緯度成分

    real(8), dimension(0:im-1,1:jm,0:km)                     :: xyz_RotLon_wt_wt
    !(out) ベクトル場の回転の経度成分

    xyz_RotLon_wt_wt =   xyz_GradLat_wt(wt_Vrad) &
         - xyz_wt(wt_RotRad_wt(wt_Vlat))

  end function xyz_RotLon_wt_wt

  function xyz_RotLat_wt_wt(wt_Vlon,wt_Vrad) 
    !
    ! ベクトル場の経度成分, 動径成分である第 1, 2 引数 Vlon, Vrad から
    ! 回転の緯度成分 
    !
    !    1/r ∂(r Vlon)/∂r - 1/rcosφ・∂Vrad/∂λ
    !
    ! を計算する.
    !
    real(8), dimension(nm+1,0:lm), intent(in) :: wt_Vlon
    !(in) ベクトル場の経度成分

    real(8), dimension(nm+1,0:lm), intent(in) :: wt_Vrad
    !(in) ベクトル場の動径成分

    real(8), dimension(0:im-1,1:jm,0:km)                     :: xyz_RotLat_wt_wt
    !(out) ベクトル場の回転の緯度成分

    xyz_RotLat_wt_wt =   xyz_wt(wt_RotRad_wt(wt_Vlon)) &
         - xyz_GradLon_wt(wt_Vrad) 

  end function xyz_RotLat_wt_wt

  function wt_RotRad_xyz_xyz(xyz_Vlat,xyz_Vlon) 
    !
    ! ベクトルの緯度成分, 経度成分である第 1, 2 引数 Vlat, Vlon に対して
    ! ベクトル場の回転の動径成分 
    !
    !    1/rcosφ・∂Vlat/∂λ - 1/rcosφ・∂(Vlon cosφ)/∂φ
    !
    ! を計算する.
    !
    real(8), dimension(0:im-1,1:jm,0:km), intent(in) :: xyz_Vlat
    !(in) ベクトル場の緯度成分

    real(8), dimension(0:im-1,1:jm,0:km), intent(in) :: xyz_Vlon
    !(in) ベクトル場の経度成分

    real(8), dimension(nm+1,0:lm)     :: wt_RotRad_xyz_xyz
    !(out) ベクトル場の回転の動径成分

    wt_RotRad_xyz_xyz =   wt_DivLon_xyz(xyz_Vlat) &
         - wt_DivLat_xyz(xyz_Vlon)

  end function wt_RotRad_xyz_xyz

  !--------------- ポロイダル/トロイダルモデル用微分 -----------------

  function wt_KxRGrad_wt(wt)
    !
    ! 入力スペクトルデータに経度微分 k×r・▽ = ∂/∂λを作用する.
    !
    real(8), dimension(nm+1,0:lm), intent(in) :: wt
    !(in) 2 次元球面調和函数チェビシェフスペクトルデータ

    real(8), dimension(nm+1,0:lm)             :: wt_KxRGrad_wt
    !(out) 経度微分を作用された 2 次元スペクトルデータ

    wt_KxRGrad_wt =  wa_Dlon_wa(wt)

  end function wt_KxRGrad_wt

  function xyz_KGrad_wt(wt)    ! k・▽ = cosφ/r ∂/∂φ + sinφ∂/∂r
    !
    ! 入力スペクトルデータに対応する格子データに軸方向微分 
    !
    !    k・▽ = cosφ/r ∂/∂φ + sinφ∂/∂r 
    !
    ! を作用させた格子データが返される. 
    ! ここでベクトル k は球の中心から北極向きの単位ベクトルである.
    !
    real(8), dimension(nm+1,0:lm), intent(in) :: wt
    !(in) 2 次元球面調和函数チェビシェフスペクトルデータ

    real(8), dimension(0:im-1,1:jm,0:km)                     :: xyz_KGrad_wt
    !(out) 軸方向微分を作用された 2 次元スペクトルデータ

    xyz_KGrad_wt =  cos(xyz_Lat)*xyz_GradLat_wt(wt) &
         + sin(xyz_Lat)*xyz_wt(wt_Drad_wt(wt))

  end function xyz_KGrad_wt

  function wt_L2_wt(wt)
    !
    ! 入力スペクトルデータに L^2 演算子(=-水平ラプラシアン)を作用する.
    !
    ! L^2 演算子は単位球面上の水平ラプラシアンの逆符号にあたる. 
    !  入力スペクトルデ ータに対応する格子点データに演算子 
    !
    !     L^2 = -1/cos^2φ・∂^2/∂λ^2 - 1/cosφ・∂/∂φ(cosφ∂/∂φ)
    !
    ! を作用させたデータのスペクトル変換が返される.
    !
    real(8), dimension(nm+1,0:lm), intent(in) :: wt
    !(in) 2 次元球面調和函数チェビシェフスペクトルデータ

    real(8), dimension(nm+1,0:lm)             :: wt_L2_wt
    !(out) L^2 演算子を作用された 2 次元スペクトルデータ

    wt_L2_wt = -wa_Lapla_wa(wt)

  end function wt_L2_wt

  function wt_L2Inv_wt(wt)
    !
    ! 入力スペクトルデータに L^2 演算子の逆演算(-逆水平ラプラシアン)を
    ! 作用する.
    !
    ! スペクトルデータに L^2 演算子を作用させる関数 wt_L2_wt の逆計算を
    ! 行う関数である.
    !
    real(8), dimension(nm+1,0:lm), intent(in) :: wt
    !(in) 2 次元球面調和函数チェビシェフスペクトルデータ

    real(8), dimension(nm+1,0:lm)             :: wt_L2Inv_wt
    !(out) L^2 演算子の逆演算を作用された 2 次元スペクトルデータ

    wt_L2Inv_wt = -wa_LaplaInv_wa(wt)

  end function wt_L2Inv_wt

  function wt_QOperator_wt(wt)
    !
    ! 入力スペクトルデータに対応する格子点データに演算子 
    !
    !    Q=(k・▽-1/2(L2 k・▽+ k・▽L2)) 
    !
    ! を作用させたデータのスペクトル変換が返される.
    !
    real(8), dimension(nm+1,0:lm), intent(in) :: wt
    !(in) 2 次元球面調和函数チェビシェフスペクトルデータ

    real(8), dimension(nm+1,0:lm)             :: wt_QOperator_wt
    !(out) Q 演算子を作用された 2 次元スペクトルデータ

    wt_QOperator_wt = &
         wt_xyz(xyz_KGrad_wt(wt) - xyz_KGrad_wt(wt_L2_wt(wt))/2) &
         - wt_L2_wt(wt_xyz(xyz_KGrad_wt(wt)))/2

  end function wt_QOperator_wt

  function wt_RadRot_xyz_xyz(xyz_VLON,xyz_VLAT)  ! r・(▽×v)
    !
    ! ベクトルの渦度と動径ベクトルの内積 r・(▽×v) を計算する.
    !
    ! 第 1, 2 引数(v[λ], v[φ])がそれぞれベクトルの経度成分, 緯度成分を表す.
    !
    !    r・(▽×v) = 1/cosφ・∂v[φ]/∂λ - 1/cosφ・∂(v[λ] cosφ)/∂φ
    !
    ! のスペクトル データが返される.
    !
    real(8), dimension(0:im-1,1:jm,0:km), intent(in) :: xyz_VLON
    !(in) ベクトルの経度成分

    real(8), dimension(0:im-1,1:jm,0:km), intent(in) :: xyz_VLAT
    !(in) ベクトルの緯度成分

    real(8), dimension(nm+1,0:lm)     :: wt_RadRot_xyz_xyz
    !(out) ベクトルの渦度と動径ベクトルの内積

    wt_RadRot_xyz_xyz = wt_wz(wa_DivLon_xya(xyz_VLAT) &
         - wa_DivLat_xya(xyz_VLON))

  end function wt_RadRot_xyz_xyz

  function wt_RadRotRot_xyz_xyz_xyz(xyz_VLON,xyz_VLAT,xyz_VRAD) 
    ! 
    ! ベクトル v に対して r・(▽×▽×v) を計算する.
    !
    ! 第 1, 2, 3 引数(v[λ], v[φ], v[r])がそれぞれベクトルの経度成分, 
    ! 緯度成分, 動径成分を表す. 
    !
    !    r・(▽×▽×v)  = 1/r ∂/∂r (r・( 1/cosφ・∂v[λ]/∂λ 
    !                                  + 1/cosφ・∂(v[φ] cosφ)/∂φ ) ) 
    !                     + L^2 v[r]/r 
    !
    ! のスペクトルデータが返される.
    !
    real(8), dimension(0:im-1,1:jm,0:km), intent(in) :: xyz_VLON
    !(in) ベクトルの経度成分

    real(8), dimension(0:im-1,1:jm,0:km), intent(in) :: xyz_VLAT
    !(in) ベクトルの緯度成分

    real(8), dimension(0:im-1,1:jm,0:km), intent(in) :: xyz_VRAD
    !(in) ベクトルの動径成分

    real(8), dimension(nm+1,0:lm)     :: wt_RadRotRot_xyz_xyz_xyz
    !(out) ベクトル v の r・(▽×▽×v) 

    wt_RadRotRot_xyz_xyz_xyz = &
         wt_RotRad_wt(wt_wz( &
         (wa_DivLon_xya(xyz_VLON)+ wa_DivLat_xya(xyz_VLAT)))) &
         + wt_L2_wt(wt_xyz(xyz_VRAD/xyz_RAD))

  end function wt_RadRotRot_xyz_xyz_xyz

  subroutine wt_Potential2Vector(&
       xyz_VLON,xyz_VLAT,xyz_VRAD,wt_TORPOT,wt_POLPOT)
    !
    ! トロイダルポロイダルポテンシャルΨ,Φで表される非発散ベクトル場
    !
    !     v = ▽x(Ψr) + ▽x▽x(Φr) 
    !
    ! の各成分を計算する
    !
    real(8), dimension(0:im-1,1:jm,0:km)     :: xyz_VLON
    !(out) ベクトル場の経度成分

    real(8), dimension(0:im-1,1:jm,0:km)     :: xyz_VLAT
    !(out) ベクトル場の緯度成分

    real(8), dimension(0:im-1,1:jm,0:km)     :: xyz_VRAD
    !(out) ベクトル場の動径成分

    real(8), dimension(nm+1,0:lm), intent(in) :: wt_TORPOT
    !(in) トロイダルポテンシャル

    real(8), dimension(nm+1,0:lm), intent(in) :: wt_POLPOT
    !(in) ポロイダルポテンシャル

    xyz_VLON =   xyz_RAD * xyz_GradLat_wt(wt_TORPOT) &
         + xya_GradLon_wa(wz_wt(wt_RotRad_wt(wt_POLPOT)))
    xyz_VLAT = - xyz_RAD * xyz_GradLon_wt(wt_TORPOT) &
         + xya_GradLat_wa(wz_wt(wt_RotRad_wt(wt_POLPOT)))
    xyz_VRAD = xyz_wt(wt_L2_wt(wt_POLPOT))/xyz_RAD

  end subroutine wt_Potential2Vector

  subroutine wt_Potential2Rotation(&
       xyz_RotVLON,xyz_RotVLAT,xyz_RotVRAD,wt_TORPOT,wt_POLPOT)
    !
    ! トロイダルポロイダルポテンシャルΨ,Φで表される非発散ベクトル場
    !
    !     v = ▽x(Ψr) + ▽x▽x(Φr) 
    !
    ! に対して, その回転
    !
    !     ▽xv = ▽x▽x(Ψr) + ▽x▽x▽x(Φr) = ▽x▽x(Ψr) - ▽x((▽^2Φ)r)
    !
    ! を計算する. 

    ! ベクトル場の回転
    real(8), dimension(0:im-1,1:jm,0:km), intent(OUT) :: xyz_RotVLON
    !(out) 回転の経度成分

    real(8), dimension(0:im-1,1:jm,0:km), intent(OUT) :: xyz_RotVLAT
    !(out) 回転の緯度成分

    real(8), dimension(0:im-1,1:jm,0:km), intent(OUT) :: xyz_RotVRAD
    !(out) 回転の動径成分

    ! 入力ベクトル場を表すポテンシャル
    real(8), dimension(nm+1,0:lm), intent(in) :: wt_TORPOT
    !(in) トロイダルポテンシャル

    real(8), dimension(nm+1,0:lm), intent(in) :: wt_POLPOT
    !(in) ポロイダルポテンシャル

    call wt_Potential2Vector( &
         xyz_RotVLON,xyz_RotVLAT,xyz_RotVRAD, &
         -wt_Lapla_wt(wt_POLPOT), wt_TORPOT)

  end subroutine wt_Potential2Rotation

  !--------------- 境界値問題 -----------------

  subroutine wt_BoundariesTau(wt,values,cond)
    !
    ! スペクトルデータにディリクレ・ノイマン境界条件を適用する
    ! Chebyshev 空間での境界条件適用(タウ法)
    !
    ! チェビシェフ空間において境界条件を満たすべく高次の係数を
    ! 定める方法をとっている(タウ法).
    !
    real(8), dimension(nm+1,0:lm),intent(inout)      :: wt
    !(inout) 境界条件を適用するデータ. 修正された値を返す. 

    real(8), dimension(nm+1,2), intent(in), optional :: values
    !(in) 境界での 値/勾配 分布を水平スペクトル変換したものを与える. 
    !     省略時は値/勾配 0 となる. 

    character(len=2), intent(in), optional             :: cond
    !(in) 境界条件. 省略時は 'DD'
    !        DD : 両端ディリクレ条件
    !        DN : 上端ディリクレ, 下端ノイマン条件
    !        ND : 上端ノイマン, 下端ディリクレ条件
    !        NN : 両端ノイマン条件

    if (.not. present(cond)) then
       if (present(values)) then
          call at_BoundariesTau_DD(wt,values)
       else
          call at_BoundariesTau_DD(wt)
       endif
       return
    endif

    select case(cond)
    case ('NN')
       if (present(values)) then
          call at_BoundariesTau_NN(wt,values)
       else
          call at_BoundariesTau_NN(wt)
       endif
    case ('DN')
       if (present(values)) then
          call at_BoundariesTau_DN(wt,values)
       else
          call at_BoundariesTau_DN(wt)
       endif
    case ('ND')
       if (present(values)) then
          call at_BoundariesTau_ND(wt,values)
       else
          call at_BoundariesTau_ND(wt)
       endif
    case ('DD')
       if (present(values)) then
          call at_BoundariesTau_DD(wt,values)
       else
          call at_BoundariesTau_DD(wt)
       endif
    case default
       call MessageNotify('E','wt_BoundariesTau','B.C. not supported')
    end select

  end subroutine wt_BoundariesTau

  subroutine wt_BoundariesGrid(wt,values,cond)
    !
    ! スペクトルデータにディリクレ・ノイマン境界条件を適用する
    ! 実空間での境界条件適用
    !
    ! 鉛直実格子点空間において内部領域の値と境界条件を満たすように
    ! 条件を課している(選点法). このルーチンを用いるためには 
    ! wt_Initial にて設定するチェビシェフ切断波数(lm)と鉛直格子点数(km)を
    ! 等しくしておく必要がある.
    !
    real(8), dimension(nm+1,0:lm),intent(inout)      :: wt
    !(inout) 境界条件を適用するデータ. 修正された値を返す. 

    real(8), dimension(nm+1,2), intent(in), optional :: values
    !(in) 境界での 値/勾配 分布を水平スペクトル変換したものを与える. 
    !    省略時は値/勾配 0 となる. 

    character(len=2), intent(in), optional             :: cond
    !(in) 境界条件. 省略時は 'DD'
    !        DD : 両端ディリクレ条件
    !        DN : 上端ディリクレ, 下端ノイマン条件
    !        ND : 上端ノイマン, 下端ディリクレ条件
    !        NN : 両端ノイマン条件

    if (.not. present(cond)) then
       if (present(values)) then
          call at_boundariesGrid_DD(wt,values)
       else
          call at_boundariesGrid_DD(wt)
       endif
       return
    endif

    select case(cond)
    case ('NN')
       if (present(values)) then
          call at_BoundariesGrid_NN(wt,values)
       else
          call at_BoundariesGrid_NN(wt)
       endif
    case ('DN')
       if (present(values)) then
          call at_BoundariesGrid_DN(wt,values)
       else
          call at_BoundariesGrid_DN(wt)
       endif
    case ('ND')
       if (present(values)) then
          call at_BoundariesGrid_ND(wt,values)
       else
          call at_BoundariesGrid_ND(wt)
       endif
    case ('DD')
       if (present(values)) then
          call at_BoundariesGrid_DD(wt,values)
       else
          call at_BoundariesGrid_DD(wt)
       endif
    case default
       call MessageNotify('E','wt_BoundariesGrid','B.C. not supported')
    end select

  end subroutine wt_BoundariesGrid

  subroutine wt_TorBoundariesTau(wt_TORPOT,values,cond,new) 
    !
    ! 速度トロイダルポテンシャルに対して境界条件を適用する. 
    ! Chebyshev 空間での境界条件適用. 
    !
    ! 速度トロイダルポテンシャルΨに対して与えられる境界条件は
    !
    !   * 粘着条件 : Ψ = Ψb(lon,lat). Ψb は境界球面での速度分布. 
    !                                   default は 0(静止状態).
    !
    !   * 応力なし条件 : ∂(Ψ/r)/∂r = 0.
    !
    ! 最初に呼ばれるときはオプショナル引数 new に関係なく行列が設定される.
    !
    real(8), dimension(nm+1,0:lm),intent(inout)      :: wt_TORPOT
    !(inout) 境界条件を適用するデータ. 修正された値を返す. 

    real(8), dimension(nm+1,2), intent(in), optional :: values
    !(in) 両端境界でのトロイダルポテンシャル
    !     粘着条件の時のみ有効

    character(len=2), intent(in), optional  :: cond
    !(in) 境界条件スイッチ. 省略時は 'RR'
    !     RR    : 両端粘着条件
    !     RF    : 上端粘着, 下端応力なし条件
    !     FR    : 上端応力なし, 下端粘着条件
    !     FF    : 両端応力なし条件

    logical, intent(IN), optional :: new
    !(in) true だと境界条件計算用行列を強制的に新たに作る.
    !     default は false.

    real(8), dimension(:,:), allocatable  :: alu
    integer, dimension(:), allocatable    :: kp
    real(8), dimension(0:lm)              :: t_data
    real(8), dimension(0:km)              :: z_data
    logical                               :: rigid1, rigid2   ! 境界条件

    logical :: new_matrix = .false.
    integer :: l
    save    :: alu, kp

    if (.not. present(cond)) then
       rigid1=.TRUE. ; rigid2=.TRUE.
    else
       select case (cond)
       case ('RR')
          rigid1 = .TRUE.  ; rigid2 = .TRUE.
       case ('RF')
          rigid1 = .TRUE.  ; rigid2 = .FALSE.
       case ('FR')
          rigid1 = .FALSE. ; rigid2 = .TRUE.
       case ('FF')
          rigid1 = .FALSE. ; rigid2 = .FALSE.
       case default
          call MessageNotify('E','wt_TorBoundariesTau','B.C. not supported')
       end select
    endif

    if (.not. present(new)) then
       new_matrix=.false.
    else 
       new_matrix=new
    endif

    if ( wt_TorBoundariesTau_first .OR. new_matrix ) then
       wt_TorBoundariesTau_first = .false.

       if ( allocated(alu) ) deallocate(alu)
       if ( allocated(kp) ) deallocate(kp)
       allocate(alu(0:lm,0:lm),kp(0:lm))

       do l=0,lm
          t_data = 0.0D0 ; t_data(l) = 1.0D0
          alu(:,l) = t_data

          ! 力学的条件粘着条件 
          if ( rigid1 ) then
             z_data = z_t(t_data)
          else
             z_data = z_t(t_dr_t(t_z(z_t(t_data)/z_rad)))
          endif
          alu(lm-1,l) = z_data(0)       ! 境界 k=0 での条件式代入

          if ( rigid2 ) then
             z_data = z_t(t_data)
          else
             z_data = z_t(t_dr_t(t_z(z_t(t_data)/z_rad)))
          endif
          alu(lm,l)   = z_data(km)      ! 境界 k=km での条件式代入
       enddo

       call ludecomp(alu,kp)

       if ( rigid1 .AND. present(values) ) then 
          call MessageNotify('M','wt_TorBoundariesTau',&
               'Toroidal potential at k=0 was given by the optional variable.')
       else if ( rigid1 .AND. (.NOT.present(values)) ) then
          call MessageNotify('M','wt_TorBoundariesTau',&
               'Toroidal potential at k=0 was set to zero.')
       else if ( (.NOT. rigid1) .AND. present(values) ) then
          call MessageNotify('W','wt_TorBoundariesTau',&
               'Boundary value k=0 cannot be set under stress-free condition.')
       endif

       if ( rigid2 .AND. present(values) ) then 
          call MessageNotify('M','wt_TorBoundariesTau',&
               'Toroidal potential at k=0 was given by the optional variable.')
       else if ( rigid2 .AND. (.NOT.present(values)) ) then
          call MessageNotify('M','wt_TorBoundariesTau',&
               'Toroidal potential at k=0 was set to zero.')
       else if ( (.NOT. rigid2) .AND. present(values) ) then
          call MessageNotify('W','wt_TorBoundariesTau',&
               'Boundary value k=0 cannot be set under stress-free condition.')
       endif

       call MessageNotify('M','wt_TorBoundariesTau',&
            'Matrix to apply  b.c. newly produced.')
    endif

    if ( rigid1 .AND. present(values) ) then
       wt_torpot(:,lm-1) = values(:,1)
    else
       wt_torpot(:,lm-1) = 0.0D0
    endif
    if ( rigid2 .AND. present(values) ) then
       wt_torpot(:,lm)   = values(:,2)
    else
       wt_torpot(:,lm) = 0.0D0
    endif

    wt_torpot = lusolve(alu,kp,wt_TORPOT)

  end subroutine wt_TorBoundariesTau

  subroutine wt_TorBoundariesGrid(wt_TORPOT,values,cond,new) 
    !
    ! 速度トロイダルポテンシャルに対して境界条件を適用する.
    ! 実空間での境界条件適用
    !
    ! 鉛直実格子点空間において内部領域の値と境界条件を満たすように
    ! 条件を課している(選点法). このルーチンを用いるためには 
    ! wt_Initial にて設定するチェビシェフ切断波数(lm)と鉛直格子点数(km)を
    ! 等しくしておく必要がある. 
    !
    ! 速度トロイダルポテンシャルΨに対して与えられる境界条件は
    !
    !   * 粘着条件 : Ψ = Ψb(lon,lat). Ψb は境界球面での速度分布. 
    !                                   default は 0 (静止状態).
    !
    !   * 応力なし条件 : ∂(Ψ/r)/∂r = 0.
    !
    ! 最初に呼ばれるときはオプショナル引数 new に関係なく行列が設定される.
    !
    real(8), dimension(nm+1,0:lm),intent(inout)      :: wt_TORPOT
    !(inout) 境界条件を適用するデータ. 修正された値を返す. 

    real(8), dimension(nm+1,2), intent(in), optional :: values
    !(in) 両端境界でのトロイダルポテンシャル
    !     粘着条件の時のみ有効

    character(len=2), intent(in), optional  :: cond
    !(in) 境界条件スイッチ. 省略時は 'RR'
    !     RR    : 両端粘着条件
    !     RF    : 上端粘着, 下端応力なし条件
    !     FR    : 上端応力なし, 下端粘着条件
    !     FF    : 両端応力なし条件

    logical, intent(IN), optional :: new
    !(in) true だと境界条件計算用行列を強制的に新たに作る.
    !     default は false.

    real(8), dimension(nm+1,0:km)  :: wz_TORPOT
    real(8), dimension(:,:), allocatable  :: alu
    integer, dimension(:), allocatable    :: kp
    real(8), dimension(0:lm)              :: t_data
    real(8), dimension(0:km)              :: z_data
    logical                               :: rigid1, rigid2   ! 境界条件

    logical :: new_matrix = .false.
    integer :: l
    save    :: alu, kp

    if (.not. present(cond)) then
       rigid1=.TRUE. ; rigid2=.TRUE.
    else
       select case (cond)
       case ('RR')
          rigid1 = .TRUE.  ; rigid2 = .TRUE.
       case ('RF')
          rigid1 = .TRUE.  ; rigid2 = .FALSE.
       case ('FR')
          rigid1 = .FALSE. ; rigid2 = .TRUE.
       case ('FF')
          rigid1 = .FALSE. ; rigid2 = .FALSE.
       case default
          call MessageNotify('E','wt_TorBoundariesGrid','B.C. not supported')
       end select
    endif

    if (.not. present(new)) then
       new_matrix=.false.
    else 
       new_matrix=new
    endif

    if ( wt_TorBoundariesGrid_first .OR. new_matrix ) then
       wt_TorBoundariesGrid_first = .false.

       if ( lm /= km ) then
          call MessageNotify('E','TorBoundariesGrid', &
               'Chebyshev truncation and number of grid points should be same.')
       endif

       if ( allocated(alu) ) deallocate(alu)
       if ( allocated(kp) ) deallocate(kp)
       allocate(alu(0:km,0:lm),kp(0:lm))

       do l=0,lm
          t_data = 0.0D0 ; t_data(l)=1.0D0
          alu(:,l) = z_t(t_data)

          if ( rigid1 ) then
             z_data = z_t(t_data)
          else
             z_data = z_t(t_dr_t(t_z(z_t(t_data)/z_rad)))
          endif
          alu(0,l) = z_data(0)        ! 境界 k=0 での条件式代入

          if ( rigid2 ) then
             z_data = z_t(t_data)
          else
             z_data = z_t(t_dr_t(t_z(z_t(t_data)/z_rad)))
          endif
          alu(km,l)   = z_data(km)    ! 境界 k=km での条件式代入
       end do

       call ludecomp(alu,kp)

       if ( rigid1 .AND. present(values) ) then 
          call MessageNotify('M','wt_TorBoundariesGrid',&
               'Toroidal potential at k=0 was given by the optional variable.')
       else if ( rigid1 .AND. (.NOT.present(values)) ) then
          call MessageNotify('M','wt_TorBoundariesGrid',&
               'Toroidal potential at k=0 was set to zero.')
       else if ( (.NOT. rigid1) .AND. present(values) ) then
          call MessageNotify('W','wt_TorBoundariesGrid',&
               'Boundary value at k=0 cannot be set under stress-free condition.')
       endif

       if ( rigid2 .AND. present(values) ) then 
          call MessageNotify('M','wt_TorBoundariesGrid',&
               'Toroidal potential at k=km was given by the optional variable.')
       else if ( rigid2 .AND. (.NOT.present(values)) ) then
          call MessageNotify('M','wt_TorBoundariesGrid',&
               'Toroidal potential at k=km was set to zero.')
       else if ( (.NOT. rigid2) .AND. present(values) ) then
          call MessageNotify('W','wt_TorBoundariesGrid',&
               'Boundary value at k=km cannot be set under stress-free condition.')
       endif

       call MessageNotify('M','wt_TorBoundariesGrid',&
            'Matrix to apply  b.c. newly produced.')
    endif

    wz_TorPot       = wz_wt(wt_TorPot)

    if ( rigid1 .AND. present(values) ) then
       wz_TorPot(:,0)  = values(:,1)
    else
       wz_TorPot(:,0)  = 0.0D0
    endif

    if ( rigid2 .AND. present(values) ) then
       wz_TorPot(:,km) = values(:,2)
    else
       wz_TorPot(:,km) = 0.0D0
    endif

    wt_torpot = lusolve(alu,kp,wz_TorPot)

  end subroutine wt_TorBoundariesGrid

  function wz_LaplaPol2Pol_wz(wz,cond,new)
    !
    ! 速度ポロイダルポテンシャルΦを▽^2Φから計算する.
    !
    ! チェビシェフ格子点空間で境界条件を適用している. 
    ! この関数を用いるためには wt_Initial にて設定する
    ! チェビシェフ切断波数(lm)と鉛直格子点数(km)を等しく
    ! しておく必要がある. 
    !
    ! 速度ポロイダルポテンシャルΦを f = ▽^2Φから定める式は
    !
    !   ▽^2Φ = f
    !     Φ = const. at boundaries.
    !     ∂Φ/∂r = 0 at boundaries           (粘着条件) 
    !     or ∂^2Φ/∂r^2 = 0 at boundaries    (応力なし条件)
    !
    ! 最初に呼ばれるときはオプショナル引数 new に関係なく行列が設定される.
    !
    real(8), dimension(nm+1,0:km),intent(in)  :: wz
    !(in) 入力▽^2φ分布

    real(8), dimension(nm+1,0:km)             :: wz_LaplaPol2Pol_wz
    !(out) 出力ポロイダルポテンシャル分布

    character(len=2), intent(in), optional  :: cond
    !(in) 境界条件スイッチ. 省略時は 'RR'
    !     RR    : 両端粘着条件
    !     RF    : 上端粘着, 下端応力なし条件
    !     FR    : 上端応力なし, 下端粘着条件
    !     FF    : 両端応力なし条件

    logical, intent(IN), optional :: new
    !(in) true だと境界条件計算用行列を強制的に新たに作る.
    !     default は false.

    real(8), dimension(:,:,:), allocatable  :: alu
    integer, dimension(:,:), allocatable    :: kp

    real(8), dimension(nm+1,0:km)  :: wz_work
    real(8), dimension(0:km,0:km)           :: gg
    real(8), dimension(0:km,0:km)           :: gg_work
    logical                                 :: rigid1, rigid2   ! 境界条件

    logical :: new_matrix = .false.
    integer :: k,n
    save    :: alu, kp

    if (.not. present(cond)) then
       rigid1=.TRUE. ; rigid2=.TRUE.
    else
       select case (cond)
       case ('RR')
          rigid1 = .TRUE.  ; rigid2 = .TRUE.
       case ('RF')
          rigid1 = .TRUE.  ; rigid2 = .FALSE.
       case ('FR')
          rigid1 = .FALSE. ; rigid2 = .TRUE.
       case ('FF')
          rigid1 = .FALSE. ; rigid2 = .FALSE.
       case default
          call MessageNotify('E','wz_LaplaPol2Pol_wz','B.C. not supported')
       end select
    endif

    if (.not. present(new)) then
       new_matrix=.false.
    else 
       new_matrix=new
    endif

    if ( wz_LaplaPol2Pol_wz_first .OR. new_matrix ) then
       wz_LaplaPol2Pol_wz_first = .false.

       if ( lm /= km ) then
          call MessageNotify('E','wz_LaplaPol2Pol_wz', &
               'Chebyshev truncation and number of grid points should be same.')
       endif

       if ( allocated(alu) ) deallocate(alu)
       if ( allocated(kp) ) deallocate(kp)
       allocate(alu(nm+1,0:km,0:km),kp(nm+1,0:km))

       do k=0,km
          wz_work = 0.0D0 ; wz_work(:,k) = 1.0D0

          ! 各水平波数に関して独立の式
          alu(:,:,k) = wz_wt(wt_lapla_wt(wt_wz(wz_work)))
       enddo

       ! 運動学的条件. 流線は境界で一定
       gg = 0.0D0
       do k=0,km
          gg(k,k)=1.0D0
       enddo
       do n=1,nm+1
          alu(n,0,:)   = gg(:,0)
          alu(n,km,:)  = gg(:,km)
       enddo

       ! 力学的条件粘着条件 
       if ( rigid1 ) then
          gg_work=az_at(at_dr_at(at_az(gg)))
       else
          gg_work=az_at(at_dr_at(at_dr_at(at_az(gg))))
       endif
       do n=1,nm+1
          alu(n,1,:) = gg_work(:,0)
       enddo

       ! 力学的条件粘着条件 
       if ( rigid2 ) then
          gg_work=az_at(at_dr_at(at_az(gg)))
       else
          gg_work=az_at(at_dr_at(at_dr_at(at_az(gg))))
       endif
       do n=1,nm+1
          alu(n,km-1,:) = gg_work(:,km)
       enddo

       call ludecomp(alu,kp)

       call MessageNotify('M','wz_LaplaPol2Pol_wz',&
            'Matrix to apply  b.c. newly produced.')
    endif

    wz_work         = wz
    wz_work(:,1)    = 0.0D0               ! 力学的条件
    wz_work(:,km-1) = 0.0D0               ! 力学的条件
    wz_work(:,0)    = 0.0D0               ! 運動学的条件
    wz_work(:,km)   = 0.0D0               ! 運動学的条件 

    wz_laplapol2pol_wz = lusolve(alu,kp,wz_work)

  end function wz_LaplaPol2Pol_wz

  function wt_LaplaPol2PolTau_wt(wt,cond,new)
    !
    ! 速度ポロイダルポテンシャルΦを▽^2Φから計算する.
    ! チェビシェフタウ法で境界条件を適用している. 
    !
    ! 速度ポロイダルポテンシャルΦを f = ▽^2Φから定める式は
    !
    !    ▽^2Φ = f
    !      Φ = const. at boundaries.
    !      ∂Φ/∂r = 0 at boundaries          (粘着条件) 
    !      or ∂^2Φ/∂r^2 = 0 at boundaries   (応力なし条件)
    !
    ! 最初に呼ばれるときはオプショナル引数 new に関係なく行列が設定される.
    !
    real(8), dimension(nm+1,0:lm),intent(in)  :: wt
    !(in) 入力▽^2φ分布

    real(8), dimension(nm+1,0:lm)             :: wt_LaplaPol2PolTau_wt
    !(out) 出力ポロイダルポテンシャル分布

    character(len=2), intent(in), optional  :: cond
    !(in) 境界条件スイッチ. 省略時は 'RR'
    !     RR    : 両端粘着条件
    !     RF    : 上端粘着, 下端応力なし条件
    !     FR    : 上端応力なし, 下端粘着条件
    !     FF    : 両端応力なし条件

    logical, intent(IN), optional :: new
    !(in) true だと境界条件計算用行列を強制的に新たに作る.
    !     default は false.

    real(8), dimension(:,:,:), allocatable  :: alu
    integer, dimension(:,:), allocatable    :: kp

    real(8), dimension(nm+1,0:km)  :: wz_work
    real(8), dimension(nm+1,0:lm)  :: wt_work
    logical                                 :: rigid1, rigid2   ! 境界条件

    logical :: new_matrix = .false.
    integer :: l
    save    :: alu, kp

    if (.not. present(cond)) then
       rigid1=.TRUE. ; rigid2=.TRUE.
    else
       select case (cond)
       case ('RR')
          rigid1 = .TRUE.  ; rigid2 = .TRUE.
       case ('RF')
          rigid1 = .TRUE.  ; rigid2 = .FALSE.
       case ('FR')
          rigid1 = .FALSE. ; rigid2 = .TRUE.
       case ('FF')
          rigid1 = .FALSE. ; rigid2 = .FALSE.
       case default
          call MessageNotify('E','wt_LaplaPol2PolTau_wt','B.C. not supported')
       end select
    endif

    if (.not. present(new)) then
       new_matrix=.false.
    else 
       new_matrix=new
    endif

    if ( wt_LaplaPol2PolTau_wt_first .OR. new_matrix ) then
       wt_LaplaPol2PolTau_wt_first = .false.

       if ( allocated(alu) ) deallocate(alu)
       if ( allocated(kp) ) deallocate(kp)
       allocate(alu(nm+1,0:lm,0:lm),kp(nm+1,0:lm))

       alu = 0.0D0
       do l=0,lm-2
          wt_work = 0.0D0 ; wt_work(:,l) = 1.0D0

          ! 各水平波数に関して独立の式
          alu(:,:,l) = wt_Lapla_wt(wt_work)
       enddo

       ! 運動学的条件. 流線は境界で一定
       do l=0,lm
          wt_work=0.0D0
          wt_work(:,l) = 1.0D0
          wz_work = wz_wt(wt_work)

          alu(:,lm-1,l)  = wz_work(:,0)
          alu(:,lm,l)    = wz_work(:,km)

          ! 力学的条件粘着条件 
          if ( rigid1 ) then
             wz_work=wz_wt(wt_DRad_wt(wt_work))
          else
             wz_work=wz_wt(wt_DRad_wt(wt_DRad_wt(wt_work)))
          endif
          alu(:,lm-2,l) = wz_work(:,0)

          ! 力学的条件粘着条件 
          if ( rigid2 ) then
             wz_work=wz_wt(wt_DRad_wt(wt_work))
          else
             wz_work=wz_wt(wt_DRad_wt(wt_DRad_wt(wt_work)))
          endif
          alu(:,lm-3,l) = wz_work(:,km)
       end do

       call ludecomp(alu,kp)

       call MessageNotify('M','wt_LaplaPol2PolTau_wt',&
            'Matrix to apply  b.c. newly produced.')
    endif

    wt_work         = wt
    wt_work(:,lm)   = 0.0D0               ! 運動学的条件 
    wt_work(:,lm-1) = 0.0D0               ! 運動学的条件
    wt_work(:,lm-2) = 0.0D0               ! 力学的条件
    wt_work(:,lm-3) = 0.0D0               ! 力学的条件

    wt_LaplaPol2PolTau_wt = lusolve(alu,kp,wt_work)

  end function wt_LaplaPol2PolTau_wt

  function wt_LaplaPol2PolGrid_wt(wt,cond,new)
    !
    ! 速度ポロイダルポテンシャルΦを▽^2Φから計算する.
    ! チェビシェフ格子点空間で境界条件を適用している. 
    !
    ! この関数を用いるためには wt_Initial にて設定する
    ! チェビシェフ切断波数(lm)と鉛直格子点数(km)を等しく
    ! しておく必要がある. 
    !
    ! 速度ポロイダルポテンシャルΦを f = ▽^2Φから定める式は
    !
    !    ▽^2Φ = f
    !      Φ = const. at boundaries.
    !      ∂Φ/∂r = 0 at boundaries          (粘着条件) 
    !      or ∂^2Φ/∂r^2 = 0 at boundaries   (応力なし条件)
    !
    ! 最初に呼ばれるときはオプショナル引数 new に関係なく行列が設定される.
    !
    ! 最終的にチェビシェフ係数の解が欲しい場合には, wz_LaplaPol2Pol_wz に
    ! 比べてチェビシェフ -- 格子点変換が 1 回分少なくて済む.
    !
    real(8), dimension(nm+1,0:lm),intent(in)  :: wt
    !(in) 入力▽^2φ分布

    real(8), dimension(nm+1,0:lm)             :: wt_LaplaPol2PolGrid_wt
    !(out) 出力ポロイダルポテンシャル分布

    character(len=2), intent(in), optional  :: cond
    !(in) 境界条件スイッチ. 省略時は 'RR'
    !     RR    : 両端粘着条件
    !     RF    : 上端粘着, 下端応力なし条件
    !     FR    : 上端応力なし, 下端粘着条件
    !     FF    : 両端応力なし条件

    logical, intent(IN), optional :: new
    !(in) true だと境界条件計算用行列を強制的に新たに作る.
    !     default は false.

    real(8), dimension(:,:,:), allocatable  :: alu
    integer, dimension(:,:), allocatable    :: kp

    real(8), dimension(nm+1,0:km)  :: wz_work
    real(8), dimension(nm+1,0:lm)  :: wt_work
    real(8), dimension(0:lm,0:lm)           :: tt_I
    real(8), dimension(0:lm,0:km)           :: tz_work
    logical                                 :: rigid1, rigid2   ! 境界条件

    logical :: new_matrix = .false.
    integer :: l,n
    save    :: alu, kp

    if (.not. present(cond)) then
       rigid1=.TRUE. ; rigid2=.TRUE.
    else
       select case (cond)
       case ('RR')
          rigid1 = .TRUE.  ; rigid2 = .TRUE.
       case ('RF')
          rigid1 = .TRUE.  ; rigid2 = .FALSE.
       case ('FR')
          rigid1 = .FALSE. ; rigid2 = .TRUE.
       case ('FF')
          rigid1 = .FALSE. ; rigid2 = .FALSE.
       case default
          call MessageNotify('E','wt_LaplaPol2PolGrid_wt','B.C. not supported')
       end select
    endif

    if (.not. present(new)) then
       new_matrix=.false.
    else 
       new_matrix=new
    endif

    if ( wt_LaplaPol2PolGrid_wt_first .OR. new_matrix ) then
       wt_LaplaPol2PolGrid_wt_first = .false.

       if ( lm /= km ) then
          call MessageNotify('E','wt_LaplaPol2PolGrid_wt', &
               'Chebyshev truncation and number of grid points should be same.')
       endif

       if ( allocated(alu) ) deallocate(alu)
       if ( allocated(kp) ) deallocate(kp)
       allocate(alu(nm+1,0:km,0:lm),kp(nm+1,0:lm))

       do l=0,lm
          wt_work = 0.0D0 ; wt_work(:,l) = 1.0D0

          ! 各水平波数に関して独立の式
          alu(:,:,l) = wz_wt(wt_Lapla_wt(wt_work))
       enddo

       ! 運動学的条件. 流線は境界で一定
       tt_I = 0.0D0
       do l=0,lm
          tt_I(l,l)=1.0D0
       enddo

       ! 非電気伝導体
       tz_work = az_at(tt_I)

       do n=1,nm+1
          alu(n,0,:)  = tz_work(:,0)
          alu(n,km,:) = tz_work(:,km)
       enddo

       ! 力学的条件粘着条件 
       if ( rigid1 ) then
          tz_work=az_at(at_Dr_at(tt_I))
       else
          tz_work=az_at(at_Dr_at(at_Dr_at(tt_I)))
       endif
       do n=1,nm+1
          alu(n,1,:) = tz_work(:,0)
       enddo

       ! 力学的条件粘着条件 
       if ( rigid2 ) then
          tz_work=az_at(at_Dr_at(tt_I))
       else
          tz_work=az_at(at_Dr_at(at_Dr_at(tt_I)))
       endif
       do n=1,nm+1
          alu(n,km-1,:) = tz_work(:,km)
       enddo

       call ludecomp(alu,kp)

       call MessageNotify('M','wt_LaplaPol2PolGrid_wt',&
            'Matrix to apply  b.c. newly produced.')
    endif

    wz_work         = wz_wt(wt)
    wz_work(:,1)    = 0.0D0               ! 力学的条件
    wz_work(:,km-1) = 0.0D0               ! 力学的条件
    wz_work(:,0)    = 0.0D0               ! 運動学的条件
    wz_work(:,km)   = 0.0D0               ! 運動学的条件 

    wt_LaplaPol2PolGrid_wt = lusolve(alu,kp,wz_work)

  end function wt_LaplaPol2PolGrid_wt

  subroutine wt_TormagBoundariesTau(wt_TOR,new)

    ! 磁場トロイダルポテンシャルに対して境界条件を適用する.
    ! Chebyshev 空間での境界条件適用
    !
    ! チェビシェフ空間において境界条件を満たすべく高次の係数を定める方法を
    ! とっている(タウ法). 現在のところ境界物質が非電気伝導体の場合のみ
    ! 対応している. その場合, 磁場トロイダルポテンシャルの境界条件は
    !
    ! 外側
    !    wt_psi = 0   at the outer boundary
    ! 内側
    !    wt_psi = 0       at the inner boundary
    ! 
    ! であるから wt_Boundaries で対応可能だが, 将来のため別途作成しておく.
    !
    ! 最初に呼ばれるときはオプショナル引数 new に関係なく行列が設定される.
    !
    real(8), dimension(nm+1,0:lm),intent(inout)   :: wt_TOR
    !(inout) 境界条件を適用するデータ. 修正された値を返す. 

    logical, intent(IN), optional :: new
    !(in) true だと境界条件計算用行列を強制的に新たに作る.
    !     default は false.

    real(8), dimension(:,:,:), allocatable  :: alu
    integer, dimension(:,:), allocatable    :: kp

    real(8), dimension(:,:), allocatable    :: wt_I
    real(8), dimension(:,:), allocatable    :: wz_PSI

    logical :: new_matrix = .false.
    integer  :: l, n
    save     :: alu, kp

    if (.not. present(new)) then
       new_matrix=.false.
    else 
       new_matrix=new
    endif

    if ( wt_TormagBoundariesTau_first .OR. new_matrix ) then
       wt_TormagBoundariesTau_first = .false.

       if ( allocated(alu) ) deallocate(alu)
       if ( allocated(kp) ) deallocate(kp)
       if ( allocated(wt_I) ) deallocate(wt_I)
       if ( allocated(wz_PSI) ) deallocate(wz_PSI)
       allocate(alu(nm+1,0:lm,0:lm),kp(nm+1,0:lm))
       allocate(wt_I(nm+1,0:lm),wz_PSI(nm+1,0:km))

       do l=0,lm
          wt_I = 0.0D0 ; wt_I(:,l)=1.0D0
          alu(:,:,l) = wt_I

          ! 非電気伝導体
          wz_PSI = wz_wt(wt_I)

          alu(:,lm-1,l) = wz_PSI(:,0)
          alu(:,lm,l)   = wz_PSI(:,km)
       enddo

       call ludecomp(alu,kp)

       deallocate(wt_I,wz_PSI)

       call MessageNotify('M','TormagBoundariesTau',&
            'Matrix to apply  b.c. newly produced.')
    endif

    wt_TOR(:,lm-1) = 0.0D0
    wt_TOR(:,lm)   = 0.0D0
    wt_TOR = lusolve(alu,kp,wt_TOR)

  end subroutine wt_TormagBoundariesTau

  subroutine wt_TormagBoundariesGrid(wt_TOR,new)
    !
    ! 磁場トロイダルポテンシャルに対して境界条件を適用する.
    ! 鉛直実空間での境界条件適用.
    !
    ! 鉛直実格子点空間において内部領域の値と境界条件を満たすように
    ! 条件を課している(選点法). このルーチンを用いるためには 
    ! wt_Initial にて設定するチェビシェフ切断波数(lm)と鉛直格子点数(km)を
    ! 等しくしておく必要がある. 
    !
    ! 現在のところ境界物質が非電気伝導体の場合のみ対応している. 
    ! その場合, 磁場トロイダルポテンシャルの境界条件は
    !
    ! 外側
    !    wt_psi = 0   at the outer boundary
    ! 内側
    !    wt_psi = 0       at the inner boundary
    ! 
    ! であるので wt_Boundaries で対応可能だが, 将来のため別途作成しておく
    !
    ! 最初に呼ばれるときはオプショナル引数 new に関係なく行列が設定される.
    !
    real(8), dimension(nm+1,0:lm),intent(inout)   :: wt_TOR
    !(inout) 境界条件を適用するデータ. 修正された値を返す. 

    logical, intent(IN), optional :: new
    !(in) true だと境界条件計算用行列を強制的に新たに作る.
    !     default は false.

    real(8), dimension(:,:,:), allocatable  :: alu
    integer, dimension(:,:), allocatable    :: kp

    real(8), dimension(:,:), allocatable    :: wt_I
    real(8), dimension(:,:), allocatable    :: wz_PSI
    real(8), dimension(nm+1,0:km)  :: wz_TOR

    logical :: new_matrix = .false.
    integer  :: l, n
    save     :: alu, kp

    if (.not. present(new)) then
       new_matrix=.false.
    else 
       new_matrix=new
    endif

    if ( wt_TormagBoundariesGrid_first .OR. new_matrix ) then
       wt_TormagBoundariesGrid_first = .false.

       if ( lm /= km ) then
          call MessageNotify('E','TorMagBoundariesGrid', &
               'Chebyshev truncation and number of grid points should be same.')
       endif

       if ( allocated(alu) ) deallocate(alu)
       if ( allocated(kp) ) deallocate(kp)
       if ( allocated(wt_I) ) deallocate(wt_I)
       if ( allocated(wz_PSI) ) deallocate(wz_PSI)
       allocate(alu(nm+1,0:km,0:lm),kp(nm+1,0:lm))
       allocate(wt_I(nm+1,0:lm),wz_PSI(nm+1,0:km))

       do l=0,lm
          wt_I = 0.0D0 ; wt_I(:,l)=1.0D0
          wz_PSI = wz_wt(wt_I)
          alu(:,:,l) = wz_PSI

          ! 非電気伝導体
          alu(:,0,l)  = wz_PSI(:,0)
          alu(:,km,l) = wz_PSI(:,km)
       enddo

       call ludecomp(alu,kp)

       deallocate(wt_I,wz_PSI)

       call MessageNotify('M','TormagBoundariesGrid',&
            'Matrix to apply  b.c. newly produced.')
    endif

    wz_TOR       = wz_wt(wt_TOR)
    wz_TOR(:,0)  = 0.0D0
    wz_TOR(:,km) = 0.0D0
    wt_TOR = lusolve(alu,kp,wz_TOR)

  end subroutine wt_TormagBoundariesGrid

  subroutine wt_PolmagBoundariesTau(wt_POL,new)
    !
    ! 磁場ポロイダルポテンシャルに対して境界条件を適用する.
    ! Chebyshev 空間での境界条件適用
    !
    ! チェビシェフ空間において境界条件を満たすべく高次の係数を定める方法を
    ! とっている(タウ法). 現在のところ境界物質が非電気伝導体の場合のみ
    ! 対応している. その場合, 磁場ポロイダルポテンシャルの各水平スペクトル
    ! 成分 h にたいして境界条件が与えられ,
    !
    !  * 外側境界 : dh/dr + (n+1)h/r = 0
    !  * 内側境界 : dh/dr - nh/r = 0
    !
    ! である. ここで n は h の水平全波数である. 
    !
    ! 最初に呼ばれるときはオプショナル引数 new に関係なく行列が設定される.
    !
    real(8), dimension(nm+1,0:lm),intent(inout)   :: wt_POL
    !(inout) 境界条件を適用するデータ. 修正された値を返す. 

    logical, intent(IN), optional :: new
    !(in) true だと境界条件計算用行列を強制的に新たに作る.
    !     default は false.

    real(8), dimension(:,:,:), allocatable  :: alu
    integer, dimension(:,:), allocatable    :: kp

    real(8), dimension(:,:), allocatable    :: wt_I
    real(8), dimension(:,:), allocatable    :: wz_PSI
    real(8), dimension(:,:), allocatable    :: wz_DPSIDR
    real(8), dimension(:), allocatable      :: w_n

    logical :: new_matrix = .false.
    integer  :: l, n, nn(2)
    save     :: alu, kp

    if (.not. present(new)) then
       new_matrix=.false.
    else 
       new_matrix=new
    endif

    if ( wt_PolmagBoundariesTau_first .OR. new_matrix ) then
       wt_PolmagBoundariesTau_first = .false.

       if ( allocated(alu) ) deallocate(alu)
       if ( allocated(kp) ) deallocate(kp)
       if ( allocated(wt_I) ) deallocate(wt_I)
       if ( allocated(wz_PSI) ) deallocate(wz_PSI)
       if ( allocated(wz_DPSIDR) ) deallocate(wz_DPSIDR)
       if ( allocated(w_n) ) deallocate(w_n)

       allocate(alu(nm+1,0:lm,0:lm),kp(nm+1,0:lm))
       allocate(wt_I(nm+1,0:lm),w_n(nm+1))
       allocate(wz_PSI(nm+1,0:km),wz_DPSIDR(nm+1,0:km))

       do n=1,nm+1
          nn=nm_l(n)
          w_n(n) = nn(1)
       enddo

       do l=0,lm
          wt_I = 0.0D0 ; wt_I(:,l) = 1.0D0
          alu(:,:,l) = wt_I

          wz_PSI = wz_wt(wt_I)
          wz_DPSIDR = wz_wt(wt_DRad_wt(wt_I))
          alu(:,lm-1,l) = wz_DPSIDR(:,0) + (w_n+1) * wz_PSI(:,0)/z_RAD(0)
          alu(:,lm,l)   = wz_DPSIDR(:,km) - w_n * wz_PSI(:,km)/z_RAD(km)
       enddo

       call ludecomp(alu,kp)

       deallocate(wt_I,wz_PSI,wz_DPSIDR,w_n)

       call MessageNotify('M','PolmagBoundariesTau',&
            'Matrix to apply  b.c. newly produced.')
    endif

    wt_POL(:,lm-1) = 0.0D0
    wt_POL(:,lm)   = 0.0D0
    wt_POL = lusolve(alu,kp,wt_POL)

  end subroutine wt_PolmagBoundariesTau

  subroutine wt_PolmagBoundariesGrid(wt_POL,new)
    !
    ! 磁場ポロイダルポテンシャルに対して境界条件を適用する.
    ! 鉛直実空間での境界条件適用. 
    !
    ! 鉛直実格子点空間において内部領域の値と境界条件を満たすように
    ! 条件を課している(選点法). このルーチンを用いるためには 
    ! wt_Initial にて設定するチェビシェフ切断波数(lm)と鉛直格子点数(km)を
    ! 等しくしておく必要がある. 
    !
    ! 現在のところ境界物質が非電気伝導体の場合のみ対応している. 
    ! その場合, 磁場ポロイダルポテンシャルの各水平スペクトル成分 h に
    ! たいして境界条件が与えられ,
    !
    !  * 外側境界 : dh/dr + (n+1)h/r = 0
    !  * 内側境界 : dh/dr - nh/r = 0
    !
    ! である. ここで n は h の水平全波数である. 
    !
    ! 最初に呼ばれるときはオプショナル引数 new に関係なく行列が設定される.
    !
    real(8), dimension(nm+1,0:lm),intent(inout)   :: wt_POL
    !(inout) 境界条件を適用するデータ. 修正された値を返す. 

    logical, intent(IN), optional :: new
    !(in) true だと境界条件計算用行列を強制的に新たに作る.
    !     default は false.

    real(8), dimension(:,:,:), allocatable  :: alu
    integer, dimension(:,:), allocatable    :: kp

    real(8), dimension(:,:), allocatable    :: wt_I
    real(8), dimension(:,:), allocatable    :: wz_PSI
    real(8), dimension(:,:), allocatable    :: wz_DPSIDR
    real(8), dimension(:), allocatable      :: w_n

    real(8), dimension(nm+1,0:km)  :: wz_POL

    logical :: new_matrix = .false.
    integer  :: l, n, nn(2)
    save     :: alu, kp

    if (.not. present(new)) then
       new_matrix=.false.
    else 
       new_matrix=new
    endif

    if ( wt_PolmagBoundariesGrid_first .OR. new_matrix ) then
       wt_PolmagBoundariesGrid_first = .false.

       if ( lm /= km ) then
          call MessageNotify('E','PolMagBoundariesGrid', &
               'Chebyshev truncation and number of grid points should be same.')
       endif

       if ( allocated(alu) )  deallocate(alu)
       if ( allocated(kp) )   deallocate(kp)
       if ( allocated(wt_I) ) deallocate(wt_I)
       if ( allocated(wz_PSI) ) deallocate(wz_PSI)
       if ( allocated(wz_DPSIDR) ) deallocate(wz_DPSIDR)
       if ( allocated(w_n) ) deallocate(w_n)

       allocate(alu(nm+1,0:lm,0:lm),kp(nm+1,0:lm))
       allocate(wt_I(nm+1,0:lm),w_n(nm+1))
       allocate(wz_PSI(nm+1,0:km),wz_DPSIDR(nm+1,0:km))

       do n=1,nm+1
          nn=nm_l(n)
          w_n(n) = nn(1)
       enddo

       do l=0,lm
          wt_I = 0.0D0 ; wt_I(:,l) = 1.0D0
          wz_PSI = wz_wt(wt_I)
          alu(:,:,l) = wz_PSI

          wz_DPSIDR = wz_wt(wt_DRad_wt(wt_I))
          alu(:,0,l)  = wz_DPSIDR(:,0) + (w_n+1) * wz_PSI(:,0)/z_RAD(0)
          alu(:,km,l) = wz_DPSIDR(:,km) - w_n * wz_PSI(:,km)/z_RAD(km)
       enddo

       call ludecomp(alu,kp)

       deallocate(wt_I,wz_PSI,wz_DPSIDR,w_n)

       call MessageNotify('M','PolmagBoundariesGrid',&
            'Matrix to apply  b.c. newly produced.')
    endif

    wz_POL       = wz_wt(wt_POL)
    wz_POL(:,0)  = 0.0D0
    wz_POL(:,km) = 0.0D0
    wt_POL = lusolve(alu,kp,wz_POL)

  end subroutine wt_PolmagBoundariesGrid

  !--------------- 補間計算 -----------------
  function Interpolate_wt(wt_data,alon,alat,arad)
    !
    ! 緯度 alon, 経度 alat 動径 arad における関数値を
    ! その球面調和変換係数 wa_data から補間計算する
    !
    real(8), intent(IN) :: wt_data(nm+1,0:lm)! スペクトルデータ
    real(8), intent(IN) :: alon                     ! 補間する位置(経度)
    real(8), intent(IN) :: alat                     ! 補間する位置(緯度)
    real(8), intent(IN) :: arad                     ! 補間する位置(動径)
    real(8) :: Interpolate_wt                       ! 補間した値

    Interpolate_wt = &
         Interpolate_w(a_Interpolate_at(wt_data,arad),alon,alat)

  end function Interpolate_wt

  !--------------- 終了処理 -----------------
  subroutine wt_Finalize
    !
    ! モジュールの終了処理(割り付け配列の解放)をおこなう. 
    !
    if ( .not. wt_initialize ) then
       call MessageNotify('W','wt_Finalize',&
            'wt_zonal_module not initialized yet')
       return
    endif

    call wa_Finalize
    call at_Finalize

    deallocate(xyz_Lon)            ! 格子点座標格納配列
    deallocate(xyz_Lat)            ! 格子点座標格納配列
    deallocate(xyz_Rad)
    deallocate(wz_Rad)

    wt_initialize = .false.

    wt_TorBoundariesTau_first = .true.
    wt_TorBoundariesGrid_first = .true.
    wz_LaplaPol2Pol_wz_first = .true.
    wt_LaplaPol2PolTau_wt_first = .true.
    wt_LaplaPol2PolGrid_wt_first = .true.
    wt_TormagBoundariesTau_first = .true.
    wt_TormagBoundariesGrid_first = .true.
    wt_PolmagBoundariesTau_first = .true.
    wt_PolmagBoundariesGrid_first = .true.

    call MessageNotify('M','wt_Finalize','wt_zonal_module (2025/12/10) is finalized')

  end subroutine wt_Finalize
 
end module wt_zonal_module
  
