scale_atmos_phy_sf_const.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scalelib.h"
module scale_atmos_phy_sf_const
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
  use scale_prof
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: atmos_phy_sf_const_setup
  public :: atmos_phy_sf_const_flux

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  integer,  private            :: atmos_phy_sf_flg_mom_flux = 0 ! application type for momentum flux
                                                                ! 0: Bulk coefficient  is constant
                                                                ! 1: Friction velocity is constant

  real(RP), private, parameter :: atmos_phy_sf_u_maxm      =  100.0_rp ! maximum limit of absolute velocity for momentum [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, parameter :: atmos_phy_sf_cm_max      = 2.5e-3_rp ! maximum limit of bulk coefficient for momentum [NIL]
  real(RP), private            :: atmos_phy_sf_cm_min      = 1.0e-5_rp ! minimum limit of bulk coefficient for momentum [NIL]

  real(RP), private            :: atmos_phy_sf_const_ustar =   0.25_rp ! constant friction velocity [m/s]
  real(RP), private            :: atmos_phy_sf_const_cm    = 0.0011_rp ! constant bulk coefficient for momentum [NIL]
  real(RP), private            :: atmos_phy_sf_const_sh    =   15.0_rp ! constant surface sensible heat flux [W/m2]
  real(RP), private            :: atmos_phy_sf_const_lh    =  115.0_rp ! constant surface latent   heat flux [W/m2]

  logical,  private            :: atmos_phy_sf_flg_sh_diurnal = .false. ! diurnal modulation for sensible heat flux?
  real(RP), private            :: atmos_phy_sf_const_freq     = 24.0_rp ! frequency of sensible heat flux modulation [hour]

  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine atmos_phy_sf_const_setup
    use scale_prc, only: &
       prc_abort
    implicit none

    namelist / param_atmos_phy_sf_const / &
       atmos_phy_sf_flg_mom_flux,   &
       atmos_phy_sf_u_minm,         &
       atmos_phy_sf_cm_min,         &
       atmos_phy_sf_const_ustar,    &
       atmos_phy_sf_const_cm,       &
       atmos_phy_sf_const_sh,       &
       atmos_phy_sf_const_lh,       &
       atmos_phy_sf_flg_sh_diurnal, &
       atmos_phy_sf_const_freq

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

    log_newline
    log_info("ATMOS_PHY_SF_const_setup",*) 'Setup'
    log_info("ATMOS_PHY_SF_const_setup",*) 'Constant flux'

    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_atmos_phy_sf_const,iostat=ierr)
    if( ierr < 0 ) then !--- missing
       log_info("ATMOS_PHY_SF_const_setup",*) 'Not found namelist. Default used.'
    elseif( ierr > 0 ) then !--- fatal error
       log_error("ATMOS_PHY_SF_const_setup",*) 'Not appropriate names in namelist PARAM_ATMOS_PHY_SF_CONST. Check!'
       call prc_abort
    endif
    log_nml(param_atmos_phy_sf_const)

    return
  end subroutine atmos_phy_sf_const_setup

  !-----------------------------------------------------------------------------
  subroutine atmos_phy_sf_const_flux( &
       IA, IS, IE, JA, JS, JE, &
       ATM_W, ATM_U, ATM_V, ATM_TEMP,               &
       ATM_Z1, SFC_DENS,                            &
       SFLX_MW, SFLX_MU, SFLX_MV, SFLX_SH, SFLX_LH, &
       SFLX_QV,                                     &
       U10, V10                                     )
    use scale_const, only: &
       pi    => const_pi
    use scale_atmos_hydrometeor, only: &
       hydrometeor_lhv => atmos_hydrometeor_lhv
    use scale_time, only: &
       time_nowsec
    implicit none
    integer, intent(in) :: IA, IS, IE
    integer, intent(in) :: JA, JS, JE

    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_TEMP(ia,ja) ! temperature at the lowermost layer (cell center) [K]
    real(RP), intent(in) :: ATM_Z1  (ia,ja) ! height of the lowermost grid from surface (cell center) [m]
    real(RP), intent(in) :: SFC_DENS(ia,ja) ! density     at the surface atmosphere [kg/m3]

    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_QV(ia,ja) ! surface flux for qv            (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) :: ATM_Uabs(ia,ja) ! absolute velocity at z1 [m/s]

    real(RP) :: Cm(ia,ja)       ! bulk coefficient for momentum
    real(RP) :: R10

    real(RP) :: modulation
    real(RP) :: LHV(ia,ja)

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

    log_progress(*) 'atmosphere / physics / surface flux / const'

    !$omp parallel do
    do j = js, je
    do i = is, ie
       atm_uabs(i,j) = min( atmos_phy_sf_u_maxm, max( atmos_phy_sf_u_minm, &
            sqrt( atm_w(i,j)**2 + atm_u(i,j)**2 + atm_v(i,j)**2 ) ) ) ! at cell center
    enddo
    enddo

    if   ( atmos_phy_sf_flg_mom_flux == 0 ) then ! Bulk coefficient is constant
       !$omp parallel do
       do j = js, je
       do i = is, ie
          cm(i,j) = atmos_phy_sf_const_cm
       enddo
       enddo
    elseif( atmos_phy_sf_flg_mom_flux == 1 ) then ! Friction velocity is constant
       !$omp parallel do
       do j = js, je
       do i = is, ie
          cm(i,j) = ( atmos_phy_sf_const_ustar / atm_uabs(i,j) )**2
          cm(i,j) = min( max( cm(i,j), atmos_phy_sf_cm_min ), atmos_phy_sf_cm_max )
       enddo
       enddo
    endif

    !-----< momentum >-----

    !$omp parallel do
    do j = js, je
    do i = is, ie
       sflx_mw(i,j) = -cm(i,j) * atm_uabs(i,j) * sfc_dens(i,j) * atm_w(i,j)
       sflx_mu(i,j) = -cm(i,j) * atm_uabs(i,j) * sfc_dens(i,j) * atm_u(i,j)
       sflx_mv(i,j) = -cm(i,j) * atm_uabs(i,j) * sfc_dens(i,j) * atm_v(i,j)
    enddo
    enddo

    !-----< heat flux >-----

    if ( atmos_phy_sf_flg_sh_diurnal ) then
       modulation = sin( 2.0_rp * pi * time_nowsec / 3600.0_rp / atmos_phy_sf_const_freq )
    else
       modulation = 1.0_rp
    endif

    !$omp parallel do
    do j = js, je
    do i = is, ie
       sflx_sh(i,j) = atmos_phy_sf_const_sh * modulation
       sflx_lh(i,j) = atmos_phy_sf_const_lh
    enddo
    enddo

    !-----< mass flux >-----
    call hydrometeor_lhv( &
         ia, is, ie, ja, js, je, &
         atm_temp(:,:), & ! [IN]
         lhv(:,:)       ) ! [OUT]

    !$omp parallel do
    do j = js, je
    do i = is, ie
       sflx_qv(i,j) = sflx_lh(i,j) / lhv(i,j)
    enddo
    enddo

    !-----< U10, V10 >-----

    !$omp parallel do
    do j = js, je
    do i = is, ie
       r10 = 10.0_rp / atm_z1(i,j)

       u10(i,j) = r10 * atm_u(i,j)
       v10(i,j) = r10 * atm_v(i,j)
    enddo
    enddo

    return
  end subroutine atmos_phy_sf_const_flux

end module scale_atmos_phy_sf_const