scale_atmos_bottom.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scalelib.h"
module scale_atmos_bottom
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
  use scale_prof
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: atmos_bottom_estimate
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine atmos_bottom_estimate( &
       KA, KS, KE, IA, IS, IE, JA, JS, JE, &
       DENS, PRES, QV, &
       SFC_TEMP,       &
       FZ,             &
       SFC_DENS, SFC_PRES )
    use scale_const, only: &
       grav    => const_grav, &
       rdry    => const_rdry, &
       epstvap => const_epstvap
    implicit none
    integer, intent(in) :: ka, ks, ke
    integer, intent(in) :: ia, is, ie
    integer, intent(in) :: ja, js, je
 
    real(rp), intent(in)  :: dens    (ka,ia,ja)
    real(rp), intent(in)  :: pres    (ka,ia,ja)
    real(rp), intent(in)  :: qv      (ka,ia,ja)
    real(rp), intent(in)  :: sfc_temp(ia,ja)
    real(rp), intent(in)  :: fz      (0:ka,ia,ja)
    real(rp), intent(out) :: sfc_dens(ia,ja)
    real(rp), intent(out) :: sfc_pres(ia,ja)
 
    real(rp) :: rtot
    real(rp) :: dz1, dz2
    real(rp) :: f2h1, f2h2
    real(rp) :: logp1, logp2
    real(rp) :: presh
 
    integer :: i, j
    !---------------------------------------------------------------------------
 
    !$acc data copyin(DENS, PRES, QV, SFC_TEMP, FZ) copyout(SFC_DENS, SFC_PRES)
 
    !$omp parallel do OMP_SCHEDULE_ &
    !$omp private (Rtot,dz1,dz2,F2H1,F2H2,LogP1,LogP2,PRESH)
    !$acc kernels
    do j = js, je
    do i = is, ie
       ! interpolate half-level pressure
       dz1 = fz(ks+1,i,j) - fz(ks,i,j)
       dz2 = fz(ks,i,j) - fz(ks-1,i,j)
 
       f2h1 = dz2 / ( dz1 + dz2 )
       f2h2 = dz1 / ( dz1 + dz2 )
 
       logp1 = log( pres(ks+1,i,j) )
       logp2 = log( pres(ks,i,j) )
 
       presh = exp( f2h1 * logp1 + f2h2 * logp2 )
 
       rtot = rdry * ( 1.0_rp + epstvap * qv(ks,i,j) )
       ! ( PRESH - SFC_PRES ) / dz2 = - GRAV * DENS(KS)
       sfc_pres(i,j) = presh + grav * dens(ks,i,j) * dz2
       sfc_dens(i,j) = sfc_pres(i,j) / ( rtot * sfc_temp(i,j) )
    enddo
    enddo
    !$acc end kernels
 
    !$acc end data
 
    return
  end subroutine atmos_bottom_estimate
 
  !-----------------------------------------------------------------------------
  function lagrange_interp( p, x, y ) result(q)
    !$acc routine seq
    implicit none
 
    real(rp), intent(in) :: p
    real(rp), intent(in) :: x(3), y(3)
    real(rp)             :: q
    !---------------------------------------------------------------------------
 
    q = ( (p-x(2)) * (p-x(3)) ) / ( (x(1)-x(2)) * (x(1)-x(3)) ) * y(1) &
      + ( (p-x(1)) * (p-x(3)) ) / ( (x(2)-x(1)) * (x(2)-x(3)) ) * y(2) &
      + ( (p-x(1)) * (p-x(2)) ) / ( (x(3)-x(1)) * (x(3)-x(2)) ) * y(3)
 
    return
  end function lagrange_interp
 
end module scale_atmos_bottom