scale_atmos_phy_sf_bulk.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "inc_openmp.h"
module scale_atmos_phy_sf_bulk
  !-----------------------------------------------------------------------------
  !
  !++ 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_phy_sf_bulk_setup
  public :: atmos_phy_sf_bulk

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  real(RP), private, parameter :: atmos_phy_sf_u_maxm = 100.0_rp ! maximum limit of absolute velocity for momentum [m/s]
  real(RP), private, parameter :: atmos_phy_sf_u_maxh = 100.0_rp ! maximum limit of absolute velocity for heat     [m/s]
  real(RP), private, parameter :: atmos_phy_sf_u_maxe = 100.0_rp ! maximum limit of absolute velocity for vapor    [m/s]
  real(RP), private            :: atmos_phy_sf_u_minm =   0.0_rp ! minimum limit of absolute velocity for momentum [m/s]
  real(RP), private            :: atmos_phy_sf_u_minh =   0.0_rp ! minimum limit of absolute velocity for heat     [m/s]
  real(RP), private            :: atmos_phy_sf_u_mine =   0.0_rp ! minimum limit of absolute velocity for vapor    [m/s]

  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine atmos_phy_sf_bulk_setup( ATMOS_PHY_SF_TYPE )
    use scale_process, only: &
       prc_mpistop
    use scale_atmos_phy_sf_bulkcoef, only: &
       sf_bulkcoef_setup => atmos_phy_sf_bulkcoef_setup
    implicit none

    character(len=*), intent(in) :: ATMOS_PHY_SF_TYPE

    namelist / param_atmos_phy_sf_bulk / &
       atmos_phy_sf_u_minm, &
       atmos_phy_sf_u_minh, &
       atmos_phy_sf_u_mine

    integer :: ierr
    !---------------------------------------------------------------------------

    if( io_l ) write(io_fid_log,*)
    if( io_l ) write(io_fid_log,*) '++++++ Module[SURFACE FLUX] / Categ[ATMOS PHYSICS] / Origin[SCALElib]'
    if( io_l ) write(io_fid_log,*) '+++ Bulk scheme'

    if ( atmos_phy_sf_type /= 'BULK' ) then
       write(*,*) 'xxx ATMOS_PHY_SF_TYPE is not BULK. Check!'
       call prc_mpistop
    endif

    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_atmos_phy_sf_bulk,iostat=ierr)
    if( ierr < 0 ) then !--- missing
       if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
    elseif( ierr > 0 ) then !--- fatal error
       write(*,*) 'xxx Not appropriate names in namelist PARAM_ATMOS_PHY_SF_BULK. Check!'
       call prc_mpistop
    endif
    if( io_lnml ) write(io_fid_log,nml=param_atmos_phy_sf_bulk)

    call sf_bulkcoef_setup

    return
  end subroutine atmos_phy_sf_bulk_setup

  !-----------------------------------------------------------------------------
  subroutine atmos_phy_sf_bulk( &
       ATM_TEMP, ATM_PRES, ATM_W, ATM_U, ATM_V,     &
       ATM_DENS,                                    &
       ATM_QTRC,                                    &
       ATM_Z1, dt,                                  &
       SFC_DENS, SFC_PRES,                          &
       SFLX_LW_dn, SFLX_SW_dn,                      &
       SFC_TEMP, SFC_albedo, SFC_beta,              &
       SFC_Z0M, SFC_Z0H, SFC_Z0E,                   &
       SFLX_MW, SFLX_MU, SFLX_MV, SFLX_SH, SFLX_LH, &
       SFLX_QTRC,                                   &
       U10, V10, T2, Q2                             )
    use scale_grid_index
    use scale_tracer
    use scale_const, only: &
       cpdry => const_cpdry, &
       rdry  => const_rdry
    use scale_atmos_phy_sf_bulkcoef, only: &
       sf_bulkcoef => atmos_phy_sf_bulkcoef
    use scale_atmos_saturation, only: &
       saturation_pres2qsat_all => atmos_saturation_pres2qsat_all
    use scale_atmos_thermodyn, only: &
       atmos_thermodyn_templhv
    use scale_roughness, only: &
       roughness
    use scale_bulkflux, only: &
       bulkflux
    implicit none

    real(RP), intent(in)    :: ATM_TEMP  (ia,ja)    ! temperature at the lowermost layer (cell center) [K]
    real(RP), intent(in)    :: ATM_PRES  (ia,ja)    ! pressure    at the lowermost layer (cell center) [Pa]
    real(RP), intent(in)    :: ATM_W     (ia,ja)    ! velocity w  at the lowermost layer (cell center) [m/s]
    real(RP), intent(in)    :: ATM_U     (ia,ja)    ! velocity u  at the lowermost layer (cell center) [m/s]
    real(RP), intent(in)    :: ATM_V     (ia,ja)    ! velocity v  at the lowermost layer (cell center) [m/s]
    real(RP), intent(in)    :: ATM_DENS  (ia,ja)    ! density     at the lowermost layer (cell center) [kg/m3]
    real(RP), intent(in)    :: ATM_QTRC  (ia,ja,qa) ! tracer      at the lowermost layer (cell center) [kg/kg]
    real(RP), intent(in)    :: ATM_Z1    (ia,ja)    ! height of the lowermost grid from surface (cell center) [m]
    real(DP), intent(in)    :: dt                   ! delta time
    real(RP), intent(in)    :: SFC_DENS  (ia,ja)    ! density     at the surface atmosphere [kg/m3]
    real(RP), intent(in)    :: SFC_PRES  (ia,ja)    ! pressure    at the surface atmosphere [Pa]
    real(RP), intent(in)    :: SFLX_LW_dn(ia,ja)    ! downward longwave  radiation flux at the surface [J/m2/s]
    real(RP), intent(in)    :: SFLX_SW_dn(ia,ja)    ! downward shortwave radiation flux at the surface [J/m2/s]
    real(RP), intent(in)    :: SFC_TEMP  (ia,ja)    ! temperature at the surface skin [K]
    real(RP), intent(in)    :: SFC_albedo(ia,ja,2)  ! surface albedo (LW/SW) [0-1]
    real(RP), intent(in)    :: SFC_beta  (ia,ja)    ! evaporation efficiency [0-1]
    real(RP), intent(inout) :: SFC_Z0M   (ia,ja)    ! surface roughness length (momentum) [m]
    real(RP), intent(inout) :: SFC_Z0H   (ia,ja)    ! surface roughness length (heat) [m]
    real(RP), intent(inout) :: SFC_Z0E   (ia,ja)    ! surface roughness length (vapor) [m]
    real(RP), intent(out)   :: SFLX_MW   (ia,ja)    ! surface flux for z-momentum    (area center)   [m/s*kg/m2/s]
    real(RP), intent(out)   :: SFLX_MU   (ia,ja)    ! surface flux for x-momentum    (area center)   [m/s*kg/m2/s]
    real(RP), intent(out)   :: SFLX_MV   (ia,ja)    ! surface flux for y-momentum    (area center)   [m/s*kg/m2/s]
    real(RP), intent(out)   :: SFLX_SH   (ia,ja)    ! surface flux for sensible heat (area center)   [J/m2/s]
    real(RP), intent(out)   :: SFLX_LH   (ia,ja)    ! surface flux for latent   heat (area center)   [J/m2/s]
    real(RP), intent(out)   :: SFLX_QTRC (ia,ja,qa) ! surface flux for tracer mass   (area center)   [kg/m2/s]
    real(RP), intent(out)   :: U10       (ia,ja)    ! velocity u        at 10m height
    real(RP), intent(out)   :: V10       (ia,ja)    ! velocity v        at 10m height
    real(RP), intent(out)   :: T2        (ia,ja)    ! temperature t     at  2m height
    real(RP), intent(out)   :: Q2        (ia,ja)    ! water vapor q     at  2m height

    real(RP) :: SFC_Z0M_t(ia,ja)
    real(RP) :: SFC_Z0H_t(ia,ja)
    real(RP) :: SFC_Z0E_t(ia,ja)

    real(RP) :: SFC_QSAT(ia,ja) ! saturatad water vapor mixing ratio [kg/kg]

    real(RP) :: PBL(ia,ja)
    real(RP) :: LHV (ia,ja)
    real(RP) :: Ustar
    real(RP) :: Tstar
    real(RP) :: Qstar
    real(RP) :: Uabs

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

    if( io_l ) write(io_fid_log,*) '*** Physics step: Surface flux(bulk)'

    call roughness( sfc_z0m_t(:,:), & ! [OUT]
                    sfc_z0h_t(:,:), & ! [OUT]
                    sfc_z0e_t(:,:), & ! [OUT]
                    sfc_z0m(:,:), & ! [IN]
                    sfc_z0h(:,:), & ! [IN]
                    sfc_z0e(:,:), & ! [IN]
                    atm_u(:,:), & ! [IN]
                    atm_v(:,:), & ! [IN]
                    atm_z1(:,:), & ! [IN]
                    dt              ) ! [IN]

    sfc_z0m(:,:) = sfc_z0m(:,:) + sfc_z0m_t(:,:) * dt
    sfc_z0h(:,:) = sfc_z0h(:,:) + sfc_z0h_t(:,:) * dt
    sfc_z0e(:,:) = sfc_z0e(:,:) + sfc_z0e_t(:,:) * dt

    call saturation_pres2qsat_all( sfc_qsat(:,:), & ! [OUT]
                                   sfc_temp(:,:), & ! [IN]
                                   sfc_pres(:,:)  ) ! [IN]

    call atmos_thermodyn_templhv( lhv, atm_temp )

    sflx_qtrc(:,:,:) = 0.0_rp
    pbl(:,:) = 100.0_rp ! tentative
    do j = js, je
    do i = is, ie

       call bulkflux( &
            ustar,              & ! [OUT]
            tstar,              & ! [OUT]
            qstar,              & ! [OUT]
            uabs,               & ! [OUT]
            atm_temp(i,j),      & ! [IN]
            sfc_temp(i,j),      & ! [IN]
            atm_pres(i,j),      & ! [IN]
            sfc_pres(i,j),      & ! [IN]
            atm_qtrc(i,j,i_qv), & ! [IN]
            sfc_qsat(i,j),      & ! [IN]
            atm_u(i,j),      & ! [IN]
            atm_v(i,j),      & ! [IN]
            atm_z1(i,j),      & ! [IN]
            pbl(i,j),      & ! [IN]
            sfc_z0m(i,j),      & ! [IN]
            sfc_z0h(i,j),      & ! [IN]
            sfc_z0e(i,j)       ) ! [IN]

       !-----< momentum >-----
       sflx_mw(i,j) = -atm_dens(i,j) * ustar**2 / uabs * atm_w(i,j)
       sflx_mu(i,j) = -atm_dens(i,j) * ustar**2 / uabs * atm_u(i,j)
       sflx_mv(i,j) = -atm_dens(i,j) * ustar**2 / uabs * atm_v(i,j)

       !-----< heat flux >-----
       sflx_sh(i,j) = -cpdry    * atm_dens(i,j) * ustar * tstar
       sflx_lh(i,j) = -lhv(i,j) * atm_dens(i,j) * ustar * qstar * sfc_beta(i,j)

       !-----< mass flux >-----
       sflx_qtrc(i,j,i_qv) = sflx_lh(i,j) / lhv(i,j)
    enddo
    enddo

    !-----< U10, T2, q2 >-----

    do j = js, je
    do i = is, ie
       u10(i,j) = atm_u(i,j) * log( 10.0_rp / sfc_z0m(i,j) ) / log( atm_z1(i,j) / sfc_z0m(i,j) )
       v10(i,j) = atm_v(i,j) * log( 10.0_rp / sfc_z0m(i,j) ) / log( atm_z1(i,j) / sfc_z0m(i,j) )
       t2(i,j) = sfc_temp(i,j) + ( atm_temp(i,j) - sfc_temp(i,j) ) &
                * ( log(  2.0_rp / sfc_z0m(i,j) ) * log(  2.0_rp / sfc_z0h(i,j) ) ) &
                / ( log( atm_z1(i,j) / sfc_z0m(i,j) ) * log( atm_z1(i,j) / sfc_z0h(i,j) ) )
       q2(i,j) = sfc_qsat(i,j) + ( atm_qtrc(i,j,i_qv) - sfc_qsat(i,j) ) &
                * ( log(  2.0_rp / sfc_z0m(i,j) ) * log(  2.0_rp / sfc_z0e(i,j) ) ) &
                / ( log( atm_z1(i,j) / sfc_z0m(i,j) ) * log( atm_z1(i,j) / sfc_z0e(i,j) ) )
    enddo
    enddo

    return
  end subroutine atmos_phy_sf_bulk

end module scale_atmos_phy_sf_bulk