Class Thermo_Advanced_Routine
In: thermo_advanced_routine.f90

基礎ルーチン, 関数集を use して複雑な熱力学関数を計算するモジュール

Methods

Included Modules

Thermo_Function Thermo_Routine Thermo_Advanced_Function analy Phys_Const Statistics

Public Instance methods

Subroutine :
x(:) :real, intent(in)
: x 方向の座標変数 [m]
y(:) :real, intent(in)
: y 方向の座標変数 [m]
z(:) :real, intent(in)
: z 方向の座標変数 [m]
pt(size(x),size(y),size(z)) :real, intent(in)
: 温位 [K]
BV(size(x),size(y),size(z)) :real, intent(inout)
: ブラントバイサラ振動数 [1/s]
undeff :real, intent(in), optional

ブラントバイサラ振動数の 2 乗を計算する.

[Source]

subroutine Brunt_Freq( x, y, z, pt, BV, undeff )
! ブラントバイサラ振動数の 2 乗を計算する.
  use analy
  use Phys_Const
  implicit none
  real, intent(in) :: x(:)  ! x 方向の座標変数 [m]
  real, intent(in) :: y(:)  ! y 方向の座標変数 [m]
  real, intent(in) :: z(:)  ! z 方向の座標変数 [m]
  real, intent(in) :: pt(size(x),size(y),size(z))  ! 温位 [K]
  real, intent(inout) :: BV(size(x),size(y),size(z))  ! ブラントバイサラ振動数 [1/s]
  real, intent(in), optional :: undeff
  integer :: i, j, k
  integer :: nx  ! 第 1 要素数
  integer :: ny  ! 第 2 要素数
  integer :: nz  ! 第 3 要素数
  real :: dx  ! x 方向の格子間隔 [m]
  real :: dy  ! y 方向の格子間隔 [m]
  real :: dz  ! z 方向の格子間隔 [m]

  nx=size(x)
  ny=size(y)
  nz=size(z)
  dx=x(2)-x(1)
  dy=y(2)-y(1)
  dz=z(2)-z(1)

  if(present(undeff))then
!$omp parallel default(shared)
!$omp do private(i,j)
     do j=1,ny
        do i=1,nx
           call grad_1d( z, pt(i,j,:), BV(i,j,:), undeff )
        end do
     end do
!$omp end do
!$omp end parallel

  else

!$omp parallel default(shared)
!$omp do private(i,j)
     do j=1,ny
        do i=1,nx
           call grad_1d( z, pt(i,j,:), BV(i,j,:) )
        end do
     end do
!$omp end do
!$omp end parallel
  end if

  do k=1,nz
     do j=1,ny
        do i=1,nx
           if(present(undeff))then
              if(BV(i,j,k)==undeff)then
                 BV(i,j,k)=undeff
              else
                 BV(i,j,k)=(g/pt(i,j,k))*BV(i,j,k)
              end if
           else
              BV(i,j,k)=(g/pt(i,j,k))*BV(i,j,k)
           end if
        end do
     end do
  end do

end subroutine
Subroutine :
x(:) :real, intent(in)
: x 方向の座標変数 [m]
y(:) :real, intent(in)
: y 方向の座標変数 [m]
z(:) :real, intent(in)
: z 方向の座標変数 [m]
pt(size(x),size(y),size(z)) :real, intent(in)
: 温位 [K]
tke(size(x),size(y),size(z)) :real, intent(in)
: tke [J/kg]
nuth(size(x),size(y),size(z)) :real, intent(inout)
: 水平渦粘性係数 [m^2/s]
nutv(size(x),size(y),size(z)) :real, intent(inout)
: 鉛直渦粘性係数 [m^2/s]
nuhh(size(x),size(y),size(z)) :real, intent(inout)
: 水平渦拡散係数 [m^2/s]
nuhv(size(x),size(y),size(z)) :real, intent(inout)
: 鉛直渦拡散係数 [m^2/s]

[Source]

subroutine EDC_TKE( x, y, z, pt, tke, nuth, nutv, nuhh, nuhv )
  use Phys_Const
  use Statistics
  use Analy
! 1.5 次の TKE を用いた渦粘性係数を計算する.
  real, intent(in) :: x(:)  ! x 方向の座標変数 [m]
  real, intent(in) :: y(:)  ! y 方向の座標変数 [m]
  real, intent(in) :: z(:)  ! z 方向の座標変数 [m]
  real, intent(in) :: pt(size(x),size(y),size(z))  ! 温位 [K]
  real, intent(in) :: tke(size(x),size(y),size(z))  ! tke [J/kg]
  real, intent(inout) :: nuth(size(x),size(y),size(z))  ! 水平渦粘性係数 [m^2/s]
  real, intent(inout) :: nutv(size(x),size(y),size(z))  ! 鉛直渦粘性係数 [m^2/s]
  real, intent(inout) :: nuhh(size(x),size(y),size(z))  ! 水平渦拡散係数 [m^2/s]
  real, intent(inout) :: nuhv(size(x),size(y),size(z))  ! 鉛直渦拡散係数 [m^2/s]
  real :: ptb(size(z)), BV(size(z))
  real, dimension(size(x),size(y),size(z)) :: lv, ls
  real :: lh, dsh, dsv
  real, parameter :: alpha=1.0e-6
  integer :: i, j, k
  integer :: nx  ! 第 1 要素数
  integer :: ny  ! 第 2 要素数
  integer :: nz  ! 第 3 要素数
  real :: dx  ! x 方向の格子間隔 [m]
  real :: dy  ! y 方向の格子間隔 [m]
  real :: dz  ! z 方向の格子間隔 [m]
  intrinsic :: min, max

  dx=x(2)-x(1)
  dy=y(2)-y(1)
  dz=z(2)-z(1)
  nx=size(x)
  ny=size(y)
  nz=size(z)

  dsh=sqrt(dx*dy)
  dsv=dz
  lh=dsh

! 温位の水平面平均
  do i=1,nz
     call Mean_2d( pt(:,:,i), ptb(i) )
  end do

! 鉛直方向に ptb のブラントバイサラ振動数を計算する.
  call Brunt_Freq( x(1:1), y(1:1), z, ptb(:), BV(:) )

! 大気の安定度で場合分け
  do k=1,nz
     do j=1,ny
        do i=1,nx
           if(BV(k)>0.0)then
              ls(i,j,k)=0.76*sqrt(tke(i,j,k)/BV(k))
              lv(i,j,k)=min(dsv,ls(i,j,k))
           else
              lv(i,j,k)=dsv
           end if
           nuth(i,j,k)=max(0.1*sqrt(tke(i,j,k))*lh,alpha*(dsh**2))
           nutv(i,j,k)=max(0.1*sqrt(tke(i,j,k))*lv(i,j,k),alpha*(dsv**2))
           nuhh(i,j,k)=3.0*nuth(i,j,k)
           nuhv(i,j,k)=nutv(i,j,k)*(1.0+2.0*(lv(i,j,k)/dsv))
        end do
     end do
  end do

end subroutine
Subroutine :
x(:) :real, intent(in)
: x 方向の座標変数 [m]
y(:) :real, intent(in)
: y 方向の座標変数 [m]
z(:) :real, intent(in)
: z 方向の座標変数 [m]
u(size(x),size(y),size(z)) :real, intent(in)
: 速度場の x 成分 [m/s]
v(size(x),size(y),size(z)) :real, intent(in)
: 速度場の y 成分 [m/s]
w(size(x),size(y),size(z)) :real, intent(in)
: 速度場の z 成分 [m/s]
rho(size(x),size(y),size(z)) :real, intent(in)
: 密度場 [kg/m^3]
pt(size(x),size(y),size(z)) :real, intent(in)
: 温位場 [K]
pv(size(x),size(y),size(z)) :real, intent(inout)
: PV [Km^2/kgs]
undeff :real, intent(in), optional
hx(size(x),size(y),size(z)) :real, intent(in), optional
: スケーリングファクター
hy(size(x),size(y),size(z)) :real, intent(in), optional
: スケーリングファクター
hz(size(x),size(y),size(z)) :real, intent(in), optional
: スケーリングファクター

エルテルのポテンシャル渦度を計算する

[Source]

subroutine Ertel_PV( x, y, z, u, v, w, rho, pt, pv, undeff, hx, hy, hz )
! エルテルのポテンシャル渦度を計算する
  use Thermo_Function
  use Thermo_Routine
  use analy 
  implicit none
  real, intent(in) :: x(:)  ! x 方向の座標変数 [m]
  real, intent(in) :: y(:)  ! y 方向の座標変数 [m]
  real, intent(in) :: z(:)  ! z 方向の座標変数 [m]
  real, intent(in) :: u(size(x),size(y),size(z))  ! 速度場の x 成分 [m/s]
  real, intent(in) :: v(size(x),size(y),size(z))  ! 速度場の y 成分 [m/s]
  real, intent(in) :: w(size(x),size(y),size(z))  ! 速度場の z 成分 [m/s]
  real, intent(in) :: rho(size(x),size(y),size(z))  ! 密度場 [kg/m^3]
  real, intent(in) :: pt(size(x),size(y),size(z))  ! 温位場 [K]
  real, intent(inout) :: pv(size(x),size(y),size(z))  ! PV [Km^2/kgs]
  real, intent(in), optional :: undeff
  real, intent(in), optional :: hx(size(x),size(y),size(z))  ! スケーリングファクター
  real, intent(in), optional :: hy(size(x),size(y),size(z))  ! スケーリングファクター
  real, intent(in), optional :: hz(size(x),size(y),size(z))  ! スケーリングファクター
  real :: tmp1(size(x),size(y),size(z))
  real :: tmp2(size(x),size(y),size(z))
  real :: tmp3(size(x),size(y),size(z))
  real :: tmp4(size(x),size(y),size(z))
  real :: tmp5(size(x),size(y),size(z))
  real :: tmp6(size(x),size(y),size(z))
  real :: tmp7(size(x),size(y),size(z))
  integer :: i, j, k
  integer :: nx  ! 第 1 要素数
  integer :: ny  ! 第 2 要素数
  integer :: nz  ! 第 3 要素数
  real :: scalex(size(x),size(y),size(z))
  real :: scaley(size(x),size(y),size(z))
  real :: scalez(size(x),size(y),size(z))

  nx=size(x)
  ny=size(y)
  nz=size(z)

  if(present(hx).and.present(hy).and.present(hz))then
     do k=1,nz
        do j=1,ny
           do i=1,nx
              scalex(i,j,k)=hx(i,j,k)
              scaley(i,j,k)=hy(i,j,k)
              scalez(i,j,k)=hz(i,j,k)
           end do
        end do
     end do
  else
     do k=1,nz
        do j=1,ny
           do i=1,nx
              scalex(i,j,k)=1.0
              scaley(i,j,k)=1.0
              scalez(i,j,k)=1.0
           end do
        end do
     end do
  end if

  if(present(undeff))then
!  温位の空間勾配を計算.
     call grad_vec_3d( x, y, z, pt, tmp1, tmp2, tmp3, undeff, scalex, scaley, scalez )
!  3 次元 rotation を計算.
     call rotate( x, y, z, u, v, w, tmp4, tmp5, tmp6, undeff, scalex, scaley, scalez )
!  omega と grad pt の内積を計算
     call dot_prod( tmp4, tmp5, tmp6, tmp1, tmp2, tmp3, tmp7, undeff )
  else
!  温位の空間勾配を計算.
     call grad_vec_3d( x, y, z, pt, tmp1, tmp2, tmp3, hx=scalex, hy=scaley, hz=scalez )
!  3 次元 rotation を計算.
     call rotate( x, y, z, u, v, w, tmp4, tmp5, tmp6, hx=scalex, hy=scaley, hz=scalez )
!  omega と grad pt の内積を計算
     call dot_prod( tmp4, tmp5, tmp6, tmp1, tmp2, tmp3, tmp7 )
  end if

  if(present(undeff))then
!$omp parallel default(shared)
!$omp do private(i,j,k)

     do k=1,nz
        do j=1,ny
           do i=1,nx
              if(tmp7(i,j,k)==undeff.or.rho(i,j,k)==undeff)then
                 pv(i,j,k)=undeff
              else
                 pv(i,j,k)=tmp7(i,j,k)/rho(i,j,k)
              end if
           end do
        end do
     end do

!$omp end do
!$omp end parallel

  else

!$omp parallel default(shared)
!$omp do private(i,j,k)

     do k=1,nz
        do j=1,ny
           do i=1,nx
              pv(i,j,k)=tmp7(i,j,k)/rho(i,j,k)
           end do
        end do
     end do

!$omp end do
!$omp end parallel

  end if

end subroutine
Subroutine :
z :real, intent(in)
: cm を求める高度 [m]
z0m :real, intent(in), dimension(:,:)
: モデルで計算される粗度高度 [m]
richard :real, intent(in), dimension(size(z0m,1),size(z0m,2))
: バルクリチャードソン数
Lo :real, intent(inout), dimension(size(z0m,1),size(z0m,2))
: 補正係数

Louis(1980) で提案されている大気の不安定度を考慮したバルク係数の補正係数を計算する関数

[Source]

subroutine Louis_horizon( z, z0m, richard, Lo )
! Louis(1980) で提案されている大気の不安定度を考慮したバルク係数の補正係数を計算する関数
  use Thermo_Advanced_Function
  implicit none
  real, intent(in) :: z  ! cm を求める高度 [m]
  real, intent(in), dimension(:,:) :: z0m  ! モデルで計算される粗度高度 [m]
  real, intent(in), dimension(size(z0m,1),size(z0m,2)) :: richard  ! バルクリチャードソン数
  real, intent(inout), dimension(size(z0m,1),size(z0m,2)) :: Lo  ! 補正係数
  real, parameter :: b=5.0, c=5.0
  real :: cm_tmp, zratio
  integer :: i, j, nx, ny

  nx=size(z0m,1)
  ny=size(z0m,2)

!$omp parallel default(shared)
!$omp do private(i,j)
  do j=1,ny
     do i=1,nx
        Lo(i,j)=Louis( z, z0m(i,j), richard(i,j) )
     end do
  end do
!$omp end do
!$omp end parallel

end subroutine
Subroutine :
za :real, intent(in)
: リチャードソン数を計算する高度 [m]
pta :real, intent(in), dimension(:,:)
: za での仮温位 [K]
ptg :real, intent(in), dimension(size(pta,1),size(pta,2))
: 地表面での温位 [K]
va :real, intent(in), dimension(size(pta,1),size(pta,2))
: 高度 za での水平風速の絶対値 [m/s]
qva :real, intent(in), dimension(size(pta,1),size(pta,2))
: za での混合比 [kg/kg]
qvs :real, intent(in), dimension(size(pta,1),size(pta,2))
: 地表面での飽和混合比 [kg/kg]
Ri :real, intent(inout), dimension(size(pta,1),size(pta,2))
: 求めるリチャードソン数

バルクリチャードソン数を計算するルーチン

[Source]

subroutine Rich_horizon( za, pta, ptg, va, qva, qvs, Ri )
! バルクリチャードソン数を計算するルーチン
  use Thermo_Advanced_Function
  implicit none
  real, intent(in) :: za  ! リチャードソン数を計算する高度 [m]
  real, intent(in), dimension(:,:) :: pta  ! za での仮温位 [K]
  real, intent(in), dimension(size(pta,1),size(pta,2)) :: ptg  ! 地表面での温位 [K]
  real, intent(in), dimension(size(pta,1),size(pta,2)) :: va  ! 高度 za での水平風速の絶対値 [m/s]
  real, intent(in), dimension(size(pta,1),size(pta,2)) :: qva  ! za での混合比 [kg/kg]
  real, intent(in), dimension(size(pta,1),size(pta,2)) :: qvs  ! 地表面での飽和混合比 [kg/kg]
  real, intent(inout), dimension(size(pta,1),size(pta,2)) :: Ri  ! 求めるリチャードソン数
  real, dimension(size(pta,1),size(pta,2)) :: ptvg, ptva, dpt
  integer :: i, j, nx, ny

  nx=size(pta,1)
  ny=size(pta,2)

!$omp parallel default(shared)
!$omp do private(i,j)
  do j=1,ny
     do i=1,nx
        Ri(i,j)=Rich( za, pta(i,j), ptg(i,j), va(i,j), qva(i,j), qvs(i,j) )
     end do
  end do
!$omp end do
!$omp end parallel

end subroutine
Subroutine :
z :real, intent(in)
: cm を求める高度 [m]
z0m :real, intent(in), dimension(:,:)
: モデルで計算される粗度高度 [m]
coem :real, intent(inout), dimension(size(z0m,1),size(z0m,2))
: バルク係数
richard :real, intent(in), dimension(size(z0m,1),size(z0m,2)), optional
: Louis (1980) のスキームで計算する場合のバルクリチャードソン数

運動量に関するバルク係数を計算するルーチン

[Source]

subroutine cm_horizon( z, z0m, coem, richard )
! 運動量に関するバルク係数を計算するルーチン
  use Thermo_Advanced_Function
  implicit none
  real, intent(in) :: z  ! cm を求める高度 [m]
  real, intent(in), dimension(:,:) :: z0m  ! モデルで計算される粗度高度 [m]
  real, intent(inout), dimension(size(z0m,1),size(z0m,2)) :: coem  ! バルク係数
  real, intent(in), dimension(size(z0m,1),size(z0m,2)), optional :: richard  ! Louis (1980) のスキームで計算する場合のバルクリチャードソン数
  integer :: i, j, nx, ny

  nx=size(z0m,1)
  ny=size(z0m,2)

  if(present(richard))then
!$omp parallel default(shared)
!$omp do private(i,j)
     do j=1,ny
        do i=1,nx
           coem(i,j)=cm( z, z0m(i,j), richard(i,j) )
        end do
     end do
!$omp end do
!$omp end parallel
  else
!$omp parallel default(shared)
!$omp do private(i,j)
     do j=1,ny
        do i=1,nx
           coem(i,j)=cm( z, z0m(i,j), richard(i,j) )
        end do
     end do
!$omp end do
!$omp end parallel
  end if

end subroutine
Subroutine :
cmd :real, intent(in), dimension(:,:)
: 高度 za でのバルク係数
va :real, intent(in), dimension(size(cmd,1),size(cmd,2))
: 高度 za での水平風の絶対値 [m/s]
velst :real, intent(inout), dimension(size(cmd,1),size(cmd,2))
: 摩擦速度 [m/s]

バルク係数, 速度から摩擦速度 u_* を計算するルーチン

[Source]

subroutine cmdva_2_ust_horizon( cmd, va, velst )
! バルク係数, 速度から摩擦速度 u_* を計算するルーチン
  use Thermo_Advanced_Function
  implicit none
  real, intent(in), dimension(:,:) :: cmd  ! 高度 za でのバルク係数
  real, intent(in), dimension(size(cmd,1),size(cmd,2)) :: va  ! 高度 za での水平風の絶対値 [m/s]
  real, intent(inout), dimension(size(cmd,1),size(cmd,2)) :: velst  ! 摩擦速度 [m/s]
  integer :: i, j, nx, ny

  nx=size(cmd,1)
  ny=size(cmd,2)

!$omp parallel default(shared)
!$omp do private(i,j)
     do j=1,ny
        do i=1,nx
           velst(i,j)=cmdva_2_ust( cmd(i,j), va(i,j) )
        end do
     end do
!$omp end do
!$omp end parallel

end subroutine
Subroutine :
taux :real, intent(in), dimension(:,:)
: 基準高度での風応力のデカルト x 成分 [N/m]
tauy :real, intent(in), dimension(size(taux,1),size(taux,2))
: 基準高度での風応力のデカルト y 成分 [N/m]
rho :real, intent(in), dimension(size(taux,1),size(taux,2))
: 基準高度での密度 [kg/m^3]
velst :real, intent(inout), dimension(size(taux,1),size(taux,2))
: 摩擦速度 [m/s]

風応力のデカルト水平 2 成分とその高度での密度から摩擦速度 u_* を計算するルーチン

[Source]

subroutine taurho_2_ust_horizon( taux, tauy, rho, velst )
! 風応力のデカルト水平 2 成分とその高度での密度から摩擦速度 u_* を計算するルーチン
  use Thermo_Advanced_Function
  implicit none
  real, intent(in), dimension(:,:) :: taux  ! 基準高度での風応力のデカルト x 成分 [N/m]
  real, intent(in), dimension(size(taux,1),size(taux,2)) :: tauy  ! 基準高度での風応力のデカルト y 成分 [N/m]
  real, intent(in), dimension(size(taux,1),size(taux,2)) :: rho  ! 基準高度での密度 [kg/m^3]
  real, intent(inout), dimension(size(taux,1),size(taux,2)) :: velst  ! 摩擦速度 [m/s]
  integer :: i, j, nx, ny

  nx=size(taux,1)
  ny=size(taux,2)

!$omp parallel default(shared)
!$omp do private(i,j)
     do j=1,ny
        do i=1,nx
           velst(i,j)=taurho_2_ust( (/ taux(i,j), tauy(i,j) /), rho(i,j) )
        end do
     end do
!$omp end do
!$omp end parallel

end subroutine