subroutine Louis_horizon( z, z0m, richard, Lo )
! Louis(1980) で提案されている大気の不安定度を考慮したバルク係数の補正係数を計算する関数
  use Thermo_Const
  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) 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 parallel do

end subroutine

subroutine Rich_horizon( za, pta, ptg, va, qva, qvs, Ri )
! バルクリチャードソン数を計算するルーチン
  use Phys_Const
  use Thermo_Function
  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) 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 parallel do

end subroutine

subroutine cm_horizon( z, z0m, coem, richard )
! 運動量に関するバルク係数を計算するルーチン
  use Thermo_Const
  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) 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 parallel do
  else
!$omp parallel default(shared) 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 parallel do
  end if

end subroutine

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

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

end subroutine