scale_atmos_sub_bottom.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
module scale_atmos_bottom
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_stdio
  use scale_prof
  use scale_grid_index
  use scale_tracer
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: atmos_bottom_estimate

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine atmos_bottom_estimate( &
       DENS,     &
       PRES,     &
       CZ,       &
       Zsfc,     &
       Z1,       &
       SFC_DENS, &
       SFC_PRES  )
    use scale_const, only: &
       grav  => const_grav
    implicit none

    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)
    do j = jsb, jeb
    do i = isb, ieb
       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)
    do j = jsb, jeb
    do i = isb, ieb
       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