! -*- mode: f90; coding: utf-8 -*- !----------------------------------------------------------------------- ! Copyright (c) 2019 SPMODEL Development Group. All rights reserved. !----------------------------------------------------------------------- !> @copyright Copyright (C) SPMODEL Development Group, 2019. !> License is MIT/X11. see [COPYRIGHT](@ref COPYRIGHT) in detail !> @author Shin-ichi Takehiro, Youhei SASAKI !> @brief !> @ref w_mpi_module の下部モジュール: 微分 !> @warning !> 本モジュールを直接呼ぶ事は想定されていないことに注意されたい． !> ユーザは w_mpi_module を呼ぶこと． ! ! 履歴 2019/03/21 竹広真一 ! 2019/10/06 佐々木洋平 ! module w_mpi_module_deriv_mint use dc_types, only: DP use dc_message, only : MessageNotify use w_mpi_module_base_mint, only : & & im, jm, mm, nm, nn, mi, jc=>jl, nc, xv_w, w_xv, c, np, icom implicit none private public w_deriv_mpi_Initial ! 初期化 public w_deriv_mpi_Finalize ! 終了処理 public w_Lapla_w, w_LaplaInv_w ! ラプラシアンと逆演算 public w_DLon_w ! 経度微分 public w_CosLatDLat_w ! 緯度微分 ! public w_DLatCosLat_w ! 緯度微分 public xv_GradLon_w, xv_GradLat_w ! 勾配型微分 public w_DivLon_xv, w_DivLat_xv ! 発散型微分 public w_Div_xv_xv ! 発散型微分 public w_JacobianMPI_w_w ! ヤコビアン public xv_GradLambda_w, xv_GradMu_w ! 勾配型微分(λ,μ座標) public w_DivLambda_xv, w_DivMu_xv ! 発散型微分(λ,μ座標) public rn ! ラプラシアン演算用配列 !--------------------------------------------------------------------- !> ラプラシアン演算用配列(w_module と互換性を保つため) !> !> スペクトルデータのラプラシアンを計算するための係数 !> 配列のサイズは(nc, 2) !> !> r(L,1) には L 番目の格納位置のスペクトルに対するラプラシアン計算の !> 係数 -n(n+1) の値が格納されている. real(DP), allocatable :: rn(:,:) !--------------------------------------------------------------------- !> ラプラシアン演算用配列 !> !> スペクトルデータのラプラシアンを計算するための係数 !> 配列のサイズは(nc*2) real(DP), allocatable :: D(:) logical :: w_deriv_mpi_initialize=.false. ! 初期化フラグ save rn, D contains !--------------------------------------------------------------------- !> スペクトル微分計算に必要となる作業領域を設定する. !> !> 他の関数を呼ぶ前に, 最初にこのサブルーチンを呼んで !> 初期設定をしなければならない. !> !> 上位サブルーチン w_mpi_initial() を使用すること. !> subroutine w_deriv_mpi_initial allocate(D(nc*2)) ! ラプラシアン演算用配列 allocate(rn(nc,2)) ! ラプラシアン演算用配列 call syinmd(mm,nn,D,icom,mi) rn = reshape(D,(/nc,2/)) w_deriv_mpi_initialize=.true. call MessageNotify('M','w_deriv_mpi_initial', & 'w_deriv_mpi_module_mint (2020/11/16) is initialized') end subroutine w_deriv_mpi_initial !--------------------------------------------------------------------- !> !> 入力スペクトルデータにラプラシアン !> \f[ !> ▽^2 = 1/\cos^2φ・∂^2/∂λ^2 + 1/\cosφ・∂/∂φ(\cosφ∂/∂φ) !> \f] !> を作用する(1 層用). !> !> スペクトルデータのラプラシアンとは, 対応する格子点データに !> ラプラシアンを作用させたデータのスペクトル変換のことである. function w_Lapla_w(w_data) !> 入力スペクトルデータ real(DP), intent(in) :: w_data(nc) !> 入力スペクトルデータのラプラシアン real(DP) :: w_Lapla_w(nc) call syclam(mm,nn,w_data,w_Lapla_w,D,1_8,icom,mi) end function w_Lapla_w !--------------------------------------------------------------------- !> 入力スペクトルデータに逆ラプラシアン !> \f[ !> ▽^{-2} !> =[1/cos^2φ・∂^2/∂λ^2 + 1/cosφ・∂/∂φ(cosφ∂/∂φ)]^{-1} !> \f] !> を作用する(1 層用). !> !> スペクトルデータの逆ラプラシアンとは, 対応する格子点データに !> 逆ラプラシアンを作用させたデータのスペクトル変換のことである. function w_LaplaInv_w(w_data) !> 入力スペクトルデータ real(DP), intent(in) :: w_data(nc) !> スペクトルデータの逆ラプラシアン real(DP) :: w_LaplaInv_w(nc) call syclam(mm,nn,w_data,w_LaplaInv_w,D,2_8,icom,mi) end function w_LaplaInv_w !--------------------------------------------------------------------- !> スペクトルデータに経度微分 \f$∂/∂λ\f$ を作用させる(1 層用). !> !> スペクトルデータの経度微分とは, 対応する格子点データに !> 経度微分\f$∂/∂λ\f$を作用させたデータのスペクトル変換のことである. !> function w_DLon_w(w_data) !> 入力スペクトルデータ real(DP), intent(in) :: w_data(nc) !> スペクトルデータの経度微分 real(DP) :: w_DLon_w(nc) call sycsmx(mm,nn,w_data,w_DLon_w,icom,mi) end function w_DLon_w !--------------------------------------------------------------------- !> スペクトルデータに緯度微分 \f$cosφ∂/∂φ\f$ を作用させる(1 層用). !> function w_CosLatDLat_w(w_data) !> スペクトルデータ real(DP), intent(in) :: w_data(nc) !> 格子点データ real(DP) :: w_CosLatDLat_w(nc) ! 作業用スペクトルデータ(SYCSMY 出力用) real(DP) :: w_Ydata((mm/(np*mi)+1)*(2*(nm+1)-mm/(np*mi)*np*mi)) call sycsmy(mm,nn,w_data,w_Ydata,c,icom,mi) call sycmpk(mm,nm,nn,w_Ydata,w_CosLatDLat_w,icom,mi) end function w_CosLatDLat_w !---------------------------------------------------------------------! !> スペクトルデータに勾配型経度微分 \f$1/\cosφ・∂/∂λ\f$ を !> 作用させた格子点データを返す(1 層用). !> function xv_GradLon_w(w_data) !> 入力スペクトルデータ real(DP), intent(in) :: w_data(nc) !> スペクトルデータを勾配型経度微分した格子点データ real(DP) :: xv_GradLon_w(0:im-1,jc) xv_GradLon_w = xv_w(w_data,ipow=1,iflag=-1) end function xv_GradLon_w !--------------------------------------------------------------------- !> スペクトルデータに勾配型緯度微分 \f$∂/∂φ\f$ を作用させて !> 格子点データに変換して返す(1 層用). !> function xv_GradLat_w(w_data) !> 入力スペクトルデータ real(DP), intent(in) :: w_data(nc) !> スペクトルデータを勾配型緯度微分した格子点データ real(DP) :: xv_GradLat_w(0:im-1,jc) xv_GradLat_w = xv_w(w_data,ipow=1,iflag=1) end function xv_GradLat_w !--------------------------------------------------------------------- !> 格子点データに発散型経度微分 \f$1/\cosφ・∂/∂λ\f$ を作用させて !> スペクトルデータに変換して返す(1 層用). !> function w_DivLon_xv(xv_data) !> 入力格子点データ real(DP), intent(in) :: xv_data(0:im-1,jc) !> 格子点データを発散型経度微分したスペクトルデータ real(DP) :: w_DivLon_xv(nc) w_DivLon_xv = w_xv(xv_data,ipow=1,iflag=-1) end function w_DivLon_xv !--------------------------------------------------------------------- !> 格子点データに発散型緯度微分 \f$1/\cosφ・∂(f \cosφ)/∂φ\f$ !> を作用させてスペクトルデータに変換して返す(1 層用). !> function w_DivLat_xv(xv_data) !> 入力格子点データ real(DP), intent(in) :: xv_data(0:im-1,jc) !> 格子点データを発散型緯度微分したスペクトルデータ real(DP) :: w_DivLat_xv(nc) w_DivLat_xv = w_xv(xv_data,ipow=1,iflag=1) end function w_DivLat_xv !--------------------------------------------------------------------- !> 2 つの入力格子点データをベクトル成分とする発散を計算し, !> スペクトルデータとして返す(1 層用). !> function w_Div_xv_xv(xv_u,xv_v) !> ベクトル経度成分の格子点データ real(DP), intent(in) :: xv_u(0:im-1,jc) !> ベクトル緯度成分の格子点データ real(DP), intent(in) :: xv_v(0:im-1,jc) !> 2 つの入力格子点データをベクトル成分とする発散のスペクトルデータ real(DP) :: w_Div_xv_xv(nc) w_Div_xv_xv = w_Divlon_xv(xv_u) + w_Divlat_xv(xv_v) end function w_Div_xv_xv !--------------------------------------------------------------------- !> 2 つのスペクトルデータにヤコビアン: !> \f{align*}{ !> J(f,g) &= ∂f/∂λ・∂g/∂μ - ∂g/∂λ・∂f/∂μ \\ !> &= ∂f/∂λ・1/\cosφ・∂g/∂φ !> - ∂g/∂λ・1/\cosφ・∂f/∂φ !>\f} !> を作用させる(1 層用). !> function w_JacobianMPI_w_w(w_a,w_b) !> 1つ目の入力スペクトルデータ real(DP), intent(in) :: w_a(nc) !> 2つ目の入力スペクトルデータ real(DP), intent(in) :: w_b(nc) !> 2 つのスペクトルデータのヤコビアン real(DP) :: w_JacobianMPI_w_w(nc) w_JacobianMPI_w_w = w_xv( & xv_w(w_DLon_w(w_a))*xv_w(w_b,ipow=2,iflag=1) & - xv_w(w_DLon_w(w_b))*xv_w(w_a,ipow=2,iflag=1) ) end function w_JacobianMPI_w_w !--------------------------------------------------------------------- !> スペクトルデータに勾配型経度微分 \f$∂/∂λ\f$ を作用する(1 層用). !> function xv_GradLambda_w(w_data) !> 入力スペクトルデータ real(DP), intent(in) :: w_data(nc) !> スペクトルデータを勾配型経度微分した格子点データ real(DP) :: xv_GradLambda_w(0:im-1,jc) xv_GradLambda_w = xv_w(w_data,ipow=0,iflag=-1) end function xv_GradLambda_w !--------------------------------------------------------------------- !> スペクトルデータに勾配型緯度微分 \f$(1-μ^2)∂/∂μ, (μ=\sinφ)\f$ !> を作用させて格子点データに変換して返す(1 層用). !> function xv_GradMu_w(w_data) !> 入力スペクトルデータ real(DP), intent(in) :: w_data(nc) !> スペクトルデータを勾配型緯度微分した格子点データ real(DP) :: xv_GradMu_w(0:im-1,jc) xv_GradMu_w = xv_w(w_data,ipow=0,iflag=1) end function xv_GradMu_w !--------------------------------------------------------------------- !> 格子点データに発散型経度微分 \f$1/(1-μ^2)・∂/∂λ, (μ=\sinφ)\f$ !> を作用させてスペクトルデータに変換して返す(1 層用). !> function w_DivLambda_xv(xv_data) !> 入力格子点データ real(DP), intent(in) :: xv_data(0:im-1,jc) !> 格子点データを発散型経度微分したスペクトルデータ real(DP) :: w_DivLambda_xv(nc) w_DivLambda_xv = w_xv(xv_data,ipow=2,iflag=-1) end function w_DivLambda_xv !--------------------------------------------------------------------- !> 格子点データに発散型緯度微分 \f$∂/∂μ, (μ=\sinφ)\f$ を作用させて !> スペクトルデータに変換して返す(1 層用). !> function w_DivMu_xv(xv_data) !> 入力格子点データ real(DP), intent(in) :: xv_data(0:im-1,jc) !> 格子点データを発散型緯度微分したスペクトルデータ real(DP) :: w_DivMu_xv(nc) w_DivMu_xv = w_xv(xv_data,ipow=2,iflag=1) end function w_DivMu_xv !--------------------------------------------------------------------- !> モジュールの終了処理(割り付け配列の解放)をおこなう. !> !> @warning !> このサブルーチンを単独で用いるのでなく, !> 上位サブルーチン w_mpi_Finalize を使用すること. !> subroutine w_deriv_mpi_finalize if ( .not. w_deriv_mpi_initialize ) then call MessageNotify('W','w_deriv_Finalize', & 'w_deriv_mpi_module_mint not initialized yet') return end if deallocate(D) ! ラプラシアン演算用配列 deallocate(rn) ! ラプラシアン演算用配列 w_deriv_mpi_initialize = .false. call MessageNotify('M','w_deriv_mpi_Finalize',& 'w_deriv_mpi_module_mint (2020/11/16) is finalized') end subroutine w_deriv_mpi_finalize end module w_mpi_module_deriv_mint