scale_land_phy_snow_diagnos.F90

Go to the documentation of this file.

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

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine land_phy_snow_diags( &
       LIA, LIS, LIE, LJA, LJS, LJE, &
       SNOW_frac,           &
       TMPA, PRSA,          &
       WA, UA, VA,          &
       RHOA, QVA,           &
       Z1, PBL,             &
       RHOS, PRSS, LST1,    &
       QVEF,                &
       Z0M, Z0H, Z0E,       &
       ZMFLX, XMFLX, YMFLX, &
       U10, V10,            &
       T2, Q2               )
    use scale_const, only: &
      pre00 => const_pre00, &
      rdry  => const_rdry,  &
      cpdry => const_cpdry, &
      rvap  => const_rvap,  &
      stb   => const_stb
    use scale_atmos_saturation, only: &
      qsat => atmos_saturation_pres2qsat_all
    use scale_bulkflux, only: &
      bulkflux
    implicit none
    integer, intent(in) :: LIA, LIS, LIE
    integer, intent(in) :: LJA, LJS, LJE

    real(RP), intent(in) :: SNOW_frac(lia,lja) ! snow fraction
    real(RP), intent(in) :: TMPA(lia,lja) ! temperature at the lowest atmospheric layer [K]
    real(RP), intent(in) :: PRSA(lia,lja) ! pressure at the lowest atmospheric layer [Pa]
    real(RP), intent(in) :: WA  (lia,lja) ! velocity w at the lowest atmospheric layer [m/s]
    real(RP), intent(in) :: UA  (lia,lja) ! velocity u at the lowest atmospheric layer [m/s]
    real(RP), intent(in) :: VA  (lia,lja) ! velocity v at the lowest atmospheric layer [m/s]
    real(RP), intent(in) :: RHOA(lia,lja) ! density at the lowest atmospheric layer [kg/m3]
    real(RP), intent(in) :: QVA (lia,lja) ! ratio of water vapor mass to total mass at the lowest atmospheric layer [kg/kg]
    real(RP), intent(in) :: Z1  (lia,lja) ! cell center height at the lowest atmospheric layer [m]
    real(RP), intent(in) :: PBL (lia,lja) ! the top of atmospheric mixing layer [m]
    real(RP), intent(in) :: RHOS(lia,lja) ! density  at the surface [kg/m3]
    real(RP), intent(in) :: PRSS(lia,lja) ! pressure at the surface [Pa]

    real(RP), intent(in) :: LST1   (lia,lja) ! land surface temperature [K]
    real(RP), intent(in) :: QVEF  (lia,lja) ! efficiency of evaporation (0-1)

    real(RP), intent(in) :: Z0M   (lia,lja) ! roughness length for momemtum [m]
    real(RP), intent(in) :: Z0H   (lia,lja) ! roughness length for heat [m]
    real(RP), intent(in) :: Z0E   (lia,lja) ! roughness length for vapor [m]

    real(RP), intent(out) :: ZMFLX(lia,lja) ! z-momentum flux at the surface [kg/m/s2]
    real(RP), intent(out) :: XMFLX(lia,lja) ! x-momentum flux at the surface [kg/m/s2]
    real(RP), intent(out) :: YMFLX(lia,lja) ! y-momentum flux at the surface [kg/m/s2]
    real(RP), intent(out) :: U10  (lia,lja) ! velocity u at 10m [m/s]
    real(RP), intent(out) :: V10  (lia,lja) ! velocity v at 10m [m/s]
    real(RP), intent(out) :: T2   (lia,lja) ! temperature at 2m [K]
    real(RP), intent(out) :: Q2   (lia,lja) ! water vapor at 2m [kg/kg]


    ! works
    real(RP) :: Ustar  ! friction velocity [m]
    real(RP) :: Tstar  ! friction potential temperature [K]
    real(RP) :: Qstar  ! friction water vapor mass ratio [kg/kg]
    real(RP) :: Uabs   ! modified absolute velocity [m/s]
    real(RP) :: Ra     ! Aerodynamic resistance (=1/Ce) [1/s]

    real(RP) :: QVsat  ! saturation water vapor mixing ratio at surface [kg/kg]
    real(RP) :: QVS    ! water vapor mixing ratio at surface [kg/kg]
    real(RP) :: Rtot   ! total gas constant
    real(RP) :: qdry   ! dry air mass ratio [kg/kg]

    real(RP) :: FracU10 ! calculation parameter for U10 [-]
    real(RP) :: FracT2  ! calculation parameter for T2 [-]
    real(RP) :: FracQ2  ! calculation parameter for Q2 [-]

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

    log_info("LAND_PHY_SNOW_DIAGS",*) 'Snow surface diagnostic'

    ! calculate surface flux
    do j = ljs, lje
    do i = lis, lie

      if( snow_frac(i,j) > 0.0_rp ) then

        qdry = 1.0_rp - qva(i,j)
        rtot = qdry * rdry + qva(i,j) * rvap

        call qsat( lst1(i,j),  prss(i,j), qdry, & ! [IN]
                   qvsat                        ) ! [OUT]

        qvs  = ( 1.0_rp - qvef(i,j) ) * qva(i,j) + qvef(i,j) * qvsat

        call bulkflux( &
            ustar,     & ! [OUT]
            tstar,     & ! [OUT]
            qstar,     & ! [OUT]
            uabs,      & ! [OUT]
            ra,        & ! [OUT]
            fracu10,   & ! [OUT]
            fract2,    & ! [OUT]
            fracq2,    & ! [OUT]
            tmpa(i,j), & ! [IN]
            lst1(i,j), & ! [IN]
            prsa(i,j), & ! [IN]
            prss(i,j), & ! [IN]
            qva(i,j), & ! [IN]
            qvs,       & ! [IN]
            ua(i,j), & ! [IN]
            va(i,j), & ! [IN]
            z1(i,j), & ! [IN]
            pbl(i,j), & ! [IN]
            z0m(i,j), & ! [IN]
            z0h(i,j), & ! [IN]
            z0e(i,j)  ) ! [IN]

        zmflx(i,j) = -rhos(i,j) * ustar * ustar / uabs * wa(i,j)
        xmflx(i,j) = -rhos(i,j) * ustar * ustar / uabs * ua(i,j)
        ymflx(i,j) = -rhos(i,j) * ustar * ustar / uabs * va(i,j)

        ! diagnostic variables for neutral state
        u10(i,j) = ua(i,j) * log( 10.0_rp / z0m(i,j) ) / log( z1(i,j) / z0m(i,j) )
        v10(i,j) = va(i,j) * log( 10.0_rp / z0m(i,j) ) / log( z1(i,j) / z0m(i,j) )
        t2(i,j) = lst1(i,j) + ( tmpa(i,j) - lst1(i,j) ) * ( log(  2.0_rp / z0m(i,j) ) * log(  2.0_rp / z0h(i,j) ) ) &
                                                         / ( log( z1(i,j) / z0m(i,j) ) * log( z1(i,j) / z0h(i,j) ) )
        q2(i,j) = qvs       + (  qva(i,j) - qvs       ) * ( log(  2.0_rp / z0m(i,j) ) * log(  2.0_rp / z0e(i,j) ) ) &
                                                         / ( log( z1(i,j) / z0m(i,j) ) * log( z1(i,j) / z0e(i,j) ) )

      else

        ! not calculate surface flux
        zmflx(i,j) = 0.0_rp
        xmflx(i,j) = 0.0_rp
        ymflx(i,j) = 0.0_rp
        u10(i,j) = 0.0_rp
        v10(i,j) = 0.0_rp
        t2(i,j) = 0.0_rp
        q2(i,j) = 0.0_rp

      end if

    end do
    end do

    return
  end subroutine land_phy_snow_diags

end module scale_land_phy_snow_diagnos