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,        &
       CZ, Zsfc, Z1,      &
       SFC_DENS, SFC_PRES )
    use scale_const, only: &
       grav  => const_grav
    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)  :: CZ      (ka,ia,ja)
    real(RP), intent(in)  :: Zsfc    (ia,ja)
    real(RP), intent(in)  :: Z1      (ia,ja)
    real(RP), intent(out) :: SFC_DENS(ia,ja)
    real(RP), intent(out) :: SFC_PRES(ia,ja)

    integer :: i, j
    !---------------------------------------------------------------------------

    ! estimate surface density (extrapolation)
    !$omp parallel do OMP_SCHEDULE_
    do j = js, je
    do i = is, ie
       sfc_dens(i,j) = lagrange_interp( zsfc(i,j),         & ! [IN]
                                        cz(ks:ks+2,i,j), & ! [IN]
                                        dens(ks:ks+2,i,j)  ) ! [IN]
    enddo
    enddo

    ! estimate surface pressure (hydrostatic balance)
    !$omp parallel do OMP_SCHEDULE_
    do j = js, je
    do i = is, ie
       sfc_pres(i,j) = pres(ks,i,j) &
                     + 0.5_rp * ( sfc_dens(i,j) + dens(ks,i,j) ) * grav * z1(i,j)
    enddo
    enddo

    return
  end subroutine atmos_bottom_estimate

  !-----------------------------------------------------------------------------
  function lagrange_interp( p, x, y ) result(q)
    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