scale_ocean_sfc_slab.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
module scale_ocean_sfc_slab
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_stdio
  use scale_grid_index
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: ocean_sfc_slab_setup
  public :: ocean_sfc_slab

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine ocean_sfc_slab_setup( OCEAN_TYPE )
    implicit none

    character(len=*), intent(in) :: ocean_type
    !---------------------------------------------------------------------------

    if( io_l ) write(io_fid_log,*)
    if( io_l ) write(io_fid_log,*) '++++++ Module[SLAB] / Categ[OCEAN SFC] / Origin[SCALElib]'

    return
  end subroutine ocean_sfc_slab_setup

  !-----------------------------------------------------------------------------
  subroutine ocean_sfc_slab( &
        SST_t,  & ! [OUT]
        ZMFLX,  & ! [OUT]
        XMFLX,  & ! [OUT]
        YMFLX,  & ! [OUT]
        SHFLX,  & ! [OUT]
        LHFLX,  & ! [OUT]
        WHFLX,  & ! [OUT]
        U10,    & ! [OUT]
        V10,    & ! [OUT]
        T2,     & ! [OUT]
        Q2,     & ! [OUT]
        TMPA,   & ! [IN]
        PRSA,   & ! [IN]
        WA,     & ! [IN]
        UA,     & ! [IN]
        VA,     & ! [IN]
        RHOA,   & ! [IN]
        QVA,    & ! [IN]
        Z1,     & ! [IN]
        PBL,    & ! [IN]
        PRSS,   & ! [IN]
        LWD,    & ! [IN]
        SWD,    & ! [IN]
        TW,     & ! [IN]
        SST,    & ! [IN]
        ALB_LW, & ! [IN]
        ALB_SW, & ! [IN]
        Z0M,    & ! [IN]
        Z0H,    & ! [IN]
        Z0E,    & ! [IN]
        dt      ) ! [IN]
    use scale_const, only: &
      pre00 => const_pre00, &
      rdry  => const_rdry,  &
      cpdry => const_cpdry, &
      stb   => const_stb
    use scale_landuse, only: &
      landuse_fact_ocean
    use scale_bulkflux, only: &
      bulkflux
    use scale_atmos_hydrometeor, only: &
      hydrometeor_lhv => atmos_hydrometeor_lhv
    use scale_atmos_saturation, only: &
      qsat => atmos_saturation_pres2qsat_all
    implicit none

    ! arguments
    real(RP), intent(out) :: sst_t(ia,ja) ! tendency of sea surface temperature
    real(RP), intent(out) :: zmflx(ia,ja) ! z-momentum flux at the surface [kg/m/s2]
    real(RP), intent(out) :: xmflx(ia,ja) ! x-momentum flux at the surface [kg/m/s2]
    real(RP), intent(out) :: ymflx(ia,ja) ! y-momentum flux at the surface [kg/m/s2]
    real(RP), intent(out) :: shflx(ia,ja) ! sensible heat flux at the surface [W/m2]
    real(RP), intent(out) :: lhflx(ia,ja) ! latent heat flux at the surface [W/m2]
    real(RP), intent(out) :: whflx(ia,ja) ! water heat flux at the surface [W/m2]
    real(RP), intent(out) :: u10  (ia,ja) ! velocity u at 10m [m/s]
    real(RP), intent(out) :: v10  (ia,ja) ! velocity v at 10m [m/s]
    real(RP), intent(out) :: t2   (ia,ja) ! temperature at 2m [K]
    real(RP), intent(out) :: q2   (ia,ja) ! water vapor at 2m [kg/kg]

    real(RP), intent(in) :: tmpa(ia,ja) ! temperature at the lowest atmospheric layer [K]
    real(RP), intent(in) :: prsa(ia,ja) ! pressure at the lowest atmospheric layer [Pa]
    real(RP), intent(in) :: wa  (ia,ja) ! velocity w at the lowest atmospheric layer [m/s]
    real(RP), intent(in) :: ua  (ia,ja) ! velocity u at the lowest atmospheric layer [m/s]
    real(RP), intent(in) :: va  (ia,ja) ! velocity v at the lowest atmospheric layer [m/s]
    real(RP), intent(in) :: rhoa(ia,ja) ! density at the lowest atmospheric layer [kg/m3]
    real(RP), intent(in) :: qva (ia,ja) ! ratio of water vapor mass to total mass at the lowest atmospheric layer [kg/kg]
    real(RP), intent(in) :: z1  (ia,ja) ! cell center height at the lowest atmospheric layer [m]
    real(RP), intent(in) :: pbl (ia,ja) ! the top of atmospheric mixing layer [m]
    real(RP), intent(in) :: prss(ia,ja) ! pressure at the surface [Pa]
    real(RP), intent(in) :: lwd (ia,ja) ! downward long-wave radiation flux at the surface [W/m2]
    real(RP), intent(in) :: swd (ia,ja) ! downward short-wave radiation flux at the surface [W/m2]

    real(RP), intent(in) :: tw    (ia,ja) ! water temperature [K]
    real(RP), intent(in) :: sst   (ia,ja) ! sea surface temperature [K]
    real(RP), intent(in) :: alb_lw(ia,ja) ! surface albedo for LW (0-1)
    real(RP), intent(in) :: alb_sw(ia,ja) ! surface albedo for SW (0-1)
    real(RP), intent(in) :: z0m   (ia,ja) ! roughness length for momentum [m]
    real(RP), intent(in) :: z0h   (ia,ja) ! roughness length for heat [m]
    real(RP), intent(in) :: z0e   (ia,ja) ! roughness length for vapor [m]
    real(DP), intent(in) :: dt            ! delta time

    ! works
    real(RP) :: sst1(ia,ja)

    real(RP) :: ustar ! friction velocity [m]
    real(RP) :: tstar ! friction temperature [K]
    real(RP) :: qstar ! friction mixing rate [kg/kg]
    real(RP) :: uabs  ! modified absolute velocity [m/s]

    real(RP) :: qvsat        ! saturation water vapor mixing ratio at surface [kg/kg]
    real(RP) :: lhv(ia,ja)   ! latent heat of vaporization [J/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
    !---------------------------------------------------------------------------

    if( io_l ) write(io_fid_log,*) '*** Ocean surface step: Slab'

    call hydrometeor_lhv( lhv(:,:), tmpa(:,:) )

    ! update surface temperature
    do j = js, je
    do i = is, ie
      sst1(i,j) = tw(i,j) ! assumed well-mixed condition
      sst_t(i,j) = ( sst1(i,j) - sst(i,j) ) / dt
    end do
    end do

    ! calculate surface flux
    do j = js, je
    do i = is, ie

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

        ! saturation at the surface
        call qsat( qvsat,     & ! [OUT]
                   sst1(i,j), & ! [IN]
                   prss(i,j)  ) ! [IN]

        call bulkflux( &
            ustar,     & ! [OUT]
            tstar,     & ! [OUT]
            qstar,     & ! [OUT]
            uabs,      & ! [OUT]
            fracu10,   & ! [OUT]
            fract2,    & ! [OUT]
            fracq2,    & ! [OUT]
            tmpa(i,j), & ! [IN]
            sst1(i,j), & ! [IN]
            prsa(i,j), & ! [IN]
            prss(i,j), & ! [IN]
            qva(i,j), & ! [IN]
            qvsat,     & ! [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) = -rhoa(i,j) * ustar**2 / uabs * wa(i,j)
        xmflx(i,j) = -rhoa(i,j) * ustar**2 / uabs * ua(i,j)
        ymflx(i,j) = -rhoa(i,j) * ustar**2 / uabs * va(i,j)

        shflx(i,j) = - rhoa(i,j) * ustar * tstar &
                   * cpdry * ( prss(i,j) / pre00 )**( rdry/cpdry )
        lhflx(i,j) = - rhoa(i,j) * ustar * qstar * lhv(i,j)

        ! calculation for residual
        whflx(i,j) = ( 1.0_rp - alb_sw(i,j) ) * swd(i,j) * (-1.0_rp) &
                   - ( 1.0_rp - alb_lw(i,j) ) * ( lwd(i,j) - stb * sst1(i,j)**4 ) &
                   + shflx(i,j) + lhflx(i,j)

        ! diagnostic variables considering unstable/stable state
        !U10(i,j) = FracU10 * UA(i,j)
        !V10(i,j) = FracU10 * VA(i,j)
        !T2 (i,j) = ( 1.0_RP - FracT2 ) * SST1(i,j) + FracT2 * TMPA(i,j)
        !Q2 (i,j) = ( 1.0_RP - FracQ2 ) * QVsat     + FracQ2 * QVA (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) = sst1(i,j) + ( tmpa(i,j) - sst1(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) = qvsat     + (  qva(i,j) - qvsat     ) * ( 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
        shflx(i,j) = 0.0_rp
        lhflx(i,j) = 0.0_rp
        whflx(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

    enddo
    enddo

    return
  end subroutine ocean_sfc_slab

end module scale_ocean_sfc_slab