!-- !---------------------------------------------------------------------- ! Copyright (c) 2019 Shin-ichi Takehiro. All rights reserved. !---------------------------------------------------------------------- !表題 ua_deriv_mpi_module_sypack ! ! spml/ua_deriv_mpi_module_sypack モジュールは球面上での流体運動を ! 球面調和函数を用いたスペクトル法によって数値計算するための ! モジュール ua_mpi_module_sypack の下部モジュールであり, スペクトル法の ! 微分計算のための Fortran90 関数を提供する. ! ! 球面上の 1 層モデル用 u_deriv_mpi_module_sypack モジュールを多層モデル用に ! 拡張したものであり, 同時に複数個のスペクトルデータ, 格子点データに ! 対する変換が行える. ! ! 内部で ISPACK3 の SYPACK の Fortran77 サブルーチンを呼んでいる. ! スペクトルデータおよび格子点データの格納方法や変換の詳しい計算法に ! ついては ISPACK3/SYPACK のマニュアルを参照されたい. ! !履歴 2019/04/30 竹広真一 ! ! 制限 ! ・変換する格子点データ, スペクトルデータの配列の大きさは決めうち ! module ua_deriv_mpi_module_sypack ! != ua_deriv_mpi_module_sypack ! ! Authors:: Shin-ichi Takehiro, Youhei SASAKI ! Version:: $Id$ ! Copyright&License:: See COPYRIGHT[link:../COPYRIGHT] ! !== 概要 ! ! spml/ua_deriv_mpi_module_sypack モジュールは球面上での流体運動を ! 球面調和函数を用いたスペクトル法によって数値計算するための ! モジュール ua_mpi_module_sypack の下部モジュールであり, スペクトル法の ! 微分計算のための Fortran90 関数を提供する. ! ! 球面上の 1 層モデル用 u_deriv_mpi_module_sypack モジュールを多層モデル用に ! 拡張したものであり, 同時に複数個のスペクトルデータ, 格子点データに ! 対する変換が行える. ! ! 内部で ISPACK3 の SYPACK の Fortran77 サブルーチンを呼んでいる. ! スペクトルデータおよび格子点データの格納方法や変換の詳しい計算法に ! ついては ISPACK3/SYPACK のマニュアルを参照されたい. ! use dc_message, only : MessageNotify use w_base_mpi_module_sypack, only : im, jm, nm=>nn, jc=>jl use w_deriv_mpi_module_sypack use ua_base_mpi_module_sypack, only : xvb_ua, ua_xvb, & nc, nmc, nms, nme, kc, km, ua_wb, wb_ua !!$ use w_module_sypack, only : w_xy, xy_w, w_Lapla_w, w_LaplaInv_w, & !!$ w_DLon_w, w_Jacobian_w_w implicit none real(8), allocatable :: rnu(:,:) ! ラプラシアン演算用配列(u_module と互換性を保つため) ! ! スペクトルデータのラプラシアンを計算するための係数 ! 配列のサイズは(nmc, 2) ! ! r(L,1) には L 番目の格納位置のスペクトルに対するラプラシアン計算の ! 係数 -n(n+1) の値が格納されている. ! private im, jm, nm, nc, kc ! for Intel Fortran private public ua_deriv_mpi_Initial public ua_deriv_mpi_Finalize public ua_Lapla_ua, ua_LaplaInv_ua ! ラプラシアンと逆演算 public ua_DLon_ua ! 経度微分 public xvb_GradLon_ua, xvb_GradLat_ua ! 勾配型微分 public ua_DivLon_xvb, ua_DivLat_xvb ! 発散型微分 public ua_Div_xvb_xvb ! 発散型微分 public ua_JacobianMPI_ua_ua ! ヤコビアン public xvb_GradLambda_ua, xvb_GradMu_ua ! 勾配型微分(λ,μ座標) public ua_DivLambda_xvb, ua_DivMu_xvb ! 発散型微分(λ,μ座標) public rn, rnu ! ラプラシアン演算用配列 contains !--------------- 初期化 ----------------- subroutine ua_deriv_mpi_initial ! ! スペクトル微分計算に必要となる作業領域を設定する. ! ! 他の関数を呼ぶ前に, 最初にこのサブルーチンを呼んで ! 初期設定をしなければならない. ! ! 上位サブルーチン ua_mpi_Initial を使用すること. ! !!$ ua_mpi_deriv_initialize=.true. call w_deriv_mpi_initial allocate(rnu(nmc,2)) ! ラプラシアン演算用配列 rnu = rn(nms:nme,:) call MessageNotify('M','ua_deriv_mpi_initial', & 'ua_deriv_mpi_module_sypack (2019/05/01)is initialized') end subroutine ua_deriv_mpi_initial !--------------- 微分計算 ----------------- function ua_Lapla_ua(ua_data) ! ! 入力スペクトルデータにラプラシアン ! ! ▽^2 = 1/cos^2φ・∂^2/∂λ^2 + 1/cosφ・∂/∂φ(cosφ∂/∂φ) ! ! を作用する(多層用). ! ! スペクトルデータのラプラシアンとは, 対応する格子点データに ! ラプラシアンを作用させたデータのスペクトル変換のことである. ! real(8), intent(in) :: ua_data(:,:) !(in) 入力スペクトルデータ real(8) :: ua_lapla_ua(nmc,size(ua_data,2)) !(out) 入力スペクトルデータのラプラシアン integer :: k do k=1,size(ua_data,2) ua_Lapla_ua(:,k) = rnu(:,1)*ua_data(:,k) enddo end function ua_Lapla_ua function ua_LaplaInv_ua(ua_data) ! ! 入力スペクトルデータに逆ラプラシアン ! ! ▽^{-2} ! =[1/cos^2φ・∂^2/∂λ^2 + 1/cosφ・∂/∂φ(cosφ∂/∂φ)]^{-1} ! ! を作用する(多層用). ! ! スペクトルデータの逆ラプラシアンとは, 対応する格子点データに ! 逆ラプラシアンを作用させたデータのスペクトル変換のことである. ! real(8), intent(in) :: ua_data(:,:) !(in) 入力スペクトルデータ real(8) :: ua_LaplaInv_ua(nmc,size(ua_data,2)) !(out) スペクトルデータの逆ラプラシアン integer :: k do k=1,size(ua_data,2) ua_LaplaInv_ua(:,k) = rnu(:,2)*ua_data(:,k) enddo end function ua_LaplaInv_ua function ua_DLon_ua(ua_data) ! ! スペクトルデータに経度微分 ∂/∂λ を作用させる(多層用). ! ! スペクトルデータの経度微分とは, 対応する格子点データに ! 経度微分∂/∂λを作用させたデータのスペクトル変換のことである. ! real(8), intent(in) :: ua_data(:,:) !(in) 入力スペクトルデータ real(8) :: ua_DLon_ua(nmc,size(ua_data,2)) !(out) スペクトルデータの経度微分 integer :: k real(8) :: wb_data(nc,kc) wb_data = wb_ua(ua_data) do k=1,kc wb_data(:,k) = w_DLon_w(wb_data(:,k)) enddo ua_DLon_ua = ua_wb(wb_data) end function ua_DLon_ua function xvb_GradLon_ua(ua_data) ! ! スペクトルデータに勾配型経度微分 1/cosφ・∂/∂λ を ! 作用させた格子点データを返す(多層用). ! real(8), intent(in) :: ua_data(nmc,km) !(in) 入力スペクトルデータ real(8) :: xvb_GradLon_ua(0:im-1,1:jc,kc) !(out) スペクトルデータを勾配型経度微分した格子点データ xvb_GradLon_ua = xvb_ua(ua_data,ipow=1,iflag=-1) end function xvb_GradLon_ua function xvb_GradLat_ua(ua_data) ! ! スペクトルデータに勾配型緯度微分 ∂/∂φ を作用させて ! 格子点データに変換して返す(多層用). ! real(8), intent(in) :: ua_data(nmc,km) !(in) 入力スペクトルデータ real(8) :: xvb_GradLat_ua(0:im-1,1:jc,kc) !(out) スペクトルデータを勾配型緯度微分した格子点データ xvb_GradLat_ua = xvb_ua(ua_data,ipow=1,iflag=1) end function xvb_GradLat_ua function ua_DivLon_xvb(xvb_data) ! ! 格子点データに発散型経度微分 1/cosφ・∂/∂λ を作用させて ! スペクトルデータに変換して返す(多層用). ! real(8), intent(in) :: xvb_data(0:im-1,jc,kc) !(in) 入力格子点データ real(8) :: ua_DivLon_xvb(nmc,km) !(out) 格子点データを発散型経度微分したスペクトルデータ ua_DivLon_xvb = ua_xvb(xvb_data,ipow=1,iflag=-1) end function ua_DivLon_xvb function ua_DivLat_xvb(xvb_data) ! ! 格子点データに発散型緯度微分 1/cosφ・∂(f cosφ)/∂φ を作用させて ! スペクトルデータに変換して返す(多層用). ! real(8), intent(in) :: xvb_data(0:im-1,jc,kc) !(in) 入力格子点データ real(8) :: ua_DivLat_xvb(nmc,km) !(out) 格子点データを発散型緯度微分したスペクトルデータ ua_DivLat_xvb = ua_xvb(xvb_data,ipow=1,iflag=1) end function ua_DivLat_xvb function ua_Div_xvb_xvb(xvb_u,xvb_v) ! ! 2 つの入力格子点データをベクトル成分とする発散を計算し, ! スペクトルデータとして返す(多層用). ! real(8), intent(in) :: xvb_u(0:im-1,jc,kc) !(in) ベクトル経度成分の格子点データ real(8), intent(in) :: xvb_v(0:im-1,jc,kc) !(in) ベクトル緯度成分の格子点データ real(8) :: ua_Div_xvb_xvb(nmc,km) !(out) 2 つの入力格子点データをベクトル成分とする発散のスペクトルデータ ua_Div_xvb_xvb = ua_DivLon_xvb(xvb_u) + ua_DivLat_xvb(xvb_v) end function ua_Div_xvb_xvb function ua_JacobianMPI_ua_ua(ua_a,ua_b) ! 2 つのスペクトルデータにヤコビアン ! ! J(f,g) = ∂f/∂λ・∂g/∂μ - ∂g/∂λ・∂f/∂μ ! = ∂f/∂λ・1/cosφ・∂g/∂φ ! - ∂g/∂λ・1/cosφ・∂f/∂φ ! ! を作用させる(多層用). ! real(8), intent(in) :: ua_a(nmc,km) !(in) 1つ目の入力スペクトルデータ real(8), intent(in) :: ua_b(nmc,km) !(in) 2つ目の入力スペクトルデータ real(8) :: ua_JacobianMPI_ua_ua(nmc,km) !(out) 2 つのスペクトルデータのヤコビアン integer :: k real(8) :: wb_a(nc,kc) real(8) :: wb_b(nc,kc) wb_a = wb_ua(ua_a) ; wb_b = wb_ua(ua_b) do k=1,kc wb_a(:,k) = w_JacobianMPI_w_w(wb_a(:,k),wb_b(:,k)) end do ua_JacobianMPI_ua_ua = ua_wb(wb_a) end function ua_JacobianMPI_ua_ua !--------------- 微分計算 (λ,μ座標系用) ----------------- function xvb_GradLambda_ua(ua_data) ! ! スペクトルデータに勾配型経度微分 ∂/∂λ を作用する(多層用). ! real(8), intent(in) :: ua_data(nmc,km) !(in) 入力スペクトルデータ real(8) :: xvb_GradLambda_ua(0:im-1,jc,kc) !(out) スペクトルデータを勾配型経度微分した格子点データ xvb_GradLambda_ua = xvb_ua(ua_data,ipow=0,iflag=-1) end function xvb_GradLambda_ua function xvb_GradMu_ua(ua_data) ! ! スペクトルデータに勾配型緯度微分 (1-μ^2)∂/∂μ (μ=sinφ) ! を作用させて格子点データに変換して返す(多層用). ! real(8), intent(in) :: ua_data(nmc,km) !(in) 入力スペクトルデータ real(8) :: xvb_GradMu_ua(0:im-1,1:jc,kc) !(out) スペクトルデータを勾配型緯度微分した格子点データ xvb_GradMu_ua = xvb_ua(ua_data,ipow=0,iflag=1) end function xvb_GradMu_ua function ua_DivLambda_xvb(xvb_data) ! ! 格子点データに発散型経度微分 1/(1-μ^2)・∂/∂λ (μ=sinφ) ! を作用させてスペクトルデータに変換して返す(多層用). ! real(8), intent(in) :: xvb_data(0:im-1,1:jc,kc) !(in) 入力格子点データ real(8) :: ua_DivLambda_xvb(nmc,km) !(out) 格子点データを発散型経度微分したスペクトルデータ ua_DivLambda_xvb = ua_xvb(xvb_data,ipow=2,iflag=-1) end function ua_DivLambda_xvb function ua_DivMu_xvb(xvb_data) ! ! 格子点データに発散型緯度微分 ∂/∂μ (μ=sinφ)を作用させて ! スペクトルデータに変換して返す(多層用). ! real(8), intent(in) :: xvb_data(0:im-1,1:jc,kc) !(in) 入力格子点データ real(8) :: ua_DivMu_xvb(nmc,km) !(out) 格子点データを発散型緯度微分したスペクトルデータ ua_DivMu_xvb = ua_xvb(xvb_data,ipow=2,iflag=1) end function ua_DivMu_xvb !--------------- 終了処理 ----------------- subroutine ua_deriv_mpi_Finalize ! ! モジュールの終了処理(割り付け配列の解放)をおこなう. ! deallocate(rnu) ! ラプラシアン演算用配列 call w_deriv_mpi_Finalize call MessageNotify('M','ua_deriv_mpi_finalize',& 'ua_deriv_mpi_module_sypack is finalized (2019/05/29) ') end subroutine ua_deriv_mpi_Finalize end module ua_deriv_mpi_module_sypack