scale_ocean_sfc_slab Module Reference

module OCEAN / Surface flux with slab ocean model More...

Functions/Subroutines
subroutine, public	ocean_sfc_slab_setup (OCEAN_TYPE)
	Setup. More...
subroutine, public	ocean_sfc_slab (SST_t, ZMFLX, XMFLX, YMFLX, SHFLX, LHFLX, WHFLX, U10, V10, T2, Q2, TMPA, PRSA, WA, UA, VA, RHOA, QVA, Z1, PBL, PRSS, LWD, SWD, TW, SST, ALB_LW, ALB_SW, Z0M, Z0H, Z0E, dt)
subroutine, public	ocean_sfc_slab_simplealbedo (SFC_albedo_t, SFC_albedo, cosSZA, dt)

Detailed Description

module OCEAN / Surface flux with slab ocean model

Description

Surface flux with slab ocean model

Author

Team SCALE

Function/Subroutine Documentation

ocean_sfc_slab_setup()

subroutine, public scale_ocean_sfc_slab::ocean_sfc_slab_setup

(

character(len=*), intent(in)

OCEAN_TYPE

)

Setup.

Definition at line 51 of file scale_ocean_sfc_slab.F90.

References scale_grid_index::ia, scale_grid_index::ie, scale_stdio::io_fid_log, scale_stdio::io_l, scale_grid_index::is, scale_grid_index::ja, scale_grid_index::je, scale_grid_index::js, scale_landuse::landuse_fact_ocean, and scale_process::prc_mpistop().

Referenced by scale_ocean_sfc::ocean_sfc_setup().

    use scale_process, only: &
       prc_mpistop
    use scale_landuse, only: &
       landuse_fact_ocean
    implicit none

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

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

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

    select case( ocean_type )
    case ( 'CONST' )
       sst_update = .false.
    case ( 'SLAB', 'FILE' )
       sst_update = .true.
    case default
       write(*,*) 'xxx wrong OCEAN_TYPE. Check!'
       call prc_mpistop
    end select

    ! judge to run slab ocean model
    allocate( is_ocn(ia,ja) )

    do j = js, je
    do i = is, ie
      if( landuse_fact_ocean(i,j) > 0.0_rp ) then
        is_ocn(i,j) = .true.
      else
        is_ocn(i,j) = .false.
      end if
    end do
    end do

    return

Here is the call graph for this function:

Here is the caller graph for this function:

ocean_sfc_slab()

subroutine, public scale_ocean_sfc_slab::ocean_sfc_slab	(	real(rp), dimension(ia,ja), intent(out)	SST_t,
		real(rp), dimension(ia,ja), intent(out)	ZMFLX,
		real(rp), dimension(ia,ja), intent(out)	XMFLX,
		real(rp), dimension(ia,ja), intent(out)	YMFLX,
		real(rp), dimension(ia,ja), intent(out)	SHFLX,
		real(rp), dimension(ia,ja), intent(out)	LHFLX,
		real(rp), dimension(ia,ja), intent(out)	WHFLX,
		real(rp), dimension (ia,ja), intent(out)	U10,
		real(rp), dimension (ia,ja), intent(out)	V10,
		real(rp), dimension (ia,ja), intent(out)	T2,
		real(rp), dimension (ia,ja), intent(out)	Q2,
		real(rp), dimension(ia,ja), intent(in)	TMPA,
		real(rp), dimension(ia,ja), intent(in)	PRSA,
		real(rp), dimension (ia,ja), intent(in)	WA,
		real(rp), dimension (ia,ja), intent(in)	UA,
		real(rp), dimension (ia,ja), intent(in)	VA,
		real(rp), dimension(ia,ja), intent(in)	RHOA,
		real(rp), dimension (ia,ja), intent(in)	QVA,
		real(rp), dimension (ia,ja), intent(in)	Z1,
		real(rp), dimension (ia,ja), intent(in)	PBL,
		real(rp), dimension(ia,ja), intent(in)	PRSS,
		real(rp), dimension (ia,ja), intent(in)	LWD,
		real(rp), dimension (ia,ja), intent(in)	SWD,
		real(rp), dimension (ia,ja), intent(in)	TW,
		real(rp), dimension (ia,ja), intent(in)	SST,
		real(rp), dimension(ia,ja), intent(in)	ALB_LW,
		real(rp), dimension(ia,ja), intent(in)	ALB_SW,
		real(rp), dimension (ia,ja), intent(in)	Z0M,
		real(rp), dimension (ia,ja), intent(in)	Z0H,
		real(rp), dimension (ia,ja), intent(in)	Z0E,
		real(dp), intent(in)	dt
	)

Definition at line 124 of file scale_ocean_sfc_slab.F90.

References scale_bulkflux::bulkflux, scale_const::const_cpdry, scale_const::const_stb, scale_grid_index::ie, scale_grid_index::is, scale_grid_index::je, scale_grid_index::js, dc_log::log(), and scale_process::prc_mpistop().

Referenced by scale_ocean_sfc::ocean_sfc_setup().

    use scale_grid_index
    use scale_process, only: &
       prc_mpistop
    use scale_const, only: &
      cpdry => const_cpdry, &
      stb   => const_stb
    use scale_bulkflux, only: &
      bulkflux
    use scale_atmos_thermodyn, only: &
       atmos_thermodyn_templhv
    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/m2/s]
    real(RP), intent(out) :: xmflx(ia,ja) ! x-momentum flux at the surface [kg/m2/s]
    real(RP), intent(out) :: ymflx(ia,ja) ! y-momentum flux at the surface [kg/m2/s]
    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) :: sqv          ! saturation water vapor mixing ratio at surface [kg/kg]
    real(RP) :: lhv(ia,ja)   ! latent heat for vaporization depending on temperature [J/kg]

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

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

    call atmos_thermodyn_templhv( lhv, tmpa )

    do j = js, je
    do i = is, ie

      if( is_ocn(i,j) ) then

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

        call bulkflux( &
            ustar,     & ! [OUT]
            tstar,     & ! [OUT]
            qstar,     & ! [OUT]
            uabs,      & ! [OUT]
            tmpa(i,j), & ! [IN]
            sst1(i,j), & ! [IN]
            prsa(i,j), & ! [IN]
            prss(i,j), & ! [IN]
            qva(i,j), & ! [IN]
            sqv,       & ! [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) = -cpdry    * rhoa(i,j) * ustar * tstar
        lhflx(i,j) = -lhv(i,j) * rhoa(i,j) * ustar * qstar

        ! 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)

        ! diagnositc variables
        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) = sqv       + (  qva(i,j) - sqv       ) * ( 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

    ! calculate tendency
    if( sst_update ) then
      do j = js, je
      do i = is, ie
        sst_t(i,j) = ( sst1(i,j) - sst(i,j) ) / dt
      enddo
      enddo
    else
      do j = js, je
      do i = is, ie
        sst_t(i,j) = 0.0_rp
      enddo
      enddo
    end if

    return

Here is the call graph for this function:

Here is the caller graph for this function:

ocean_sfc_slab_simplealbedo()

subroutine, public scale_ocean_sfc_slab::ocean_sfc_slab_simplealbedo	(	real(rp), dimension(ia,ja,2), intent(out)	SFC_albedo_t,
		real(rp), dimension (ia,ja,2), intent(in)	SFC_albedo,
		real(rp), dimension (ia,ja), intent(in)	cosSZA,
		real(dp), intent(in)	dt
	)

Definition at line 286 of file scale_ocean_sfc_slab.F90.

References scale_const::const_i_lw, scale_const::const_i_sw, scale_grid_index::ie, scale_grid_index::is, scale_grid_index::je, and scale_grid_index::js.

Referenced by scale_ocean_sfc::ocean_sfc_setup().

    use scale_grid_index
    use scale_const, only: &
       i_sw  => const_i_sw, &
       i_lw  => const_i_lw
    implicit none

    ! arguments
    real(RP), intent(out) :: sfc_albedo_t(ia,ja,2) ! tendency of sea surface albedo [0-1]
    real(RP), intent(in)  :: sfc_albedo  (ia,ja,2) ! sea surface                    [0-1]
    real(RP), intent(in)  :: cossza      (ia,ja)   ! cos(solar zenith angle)        [0-1]
    real(DP), intent(in)  :: dt                    ! delta time

    ! works
    real(RP) :: sfc_albedo1(ia,ja,2)
    real(RP) :: am1

    real(RP), parameter :: c_ocean_albedo(3) = (/ -0.747900_rp, &
                                                  -4.677039_rp, &
                                                   1.583171_rp  /)

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

    do j = js, je
    do i = is, ie
       am1 = max( min( cossza(i,j), 0.961_rp ), 0.0349_rp )

       ! SFC_albedo1(i,j,I_LW) = 0.5_RP do nothing
       sfc_albedo1(i,j,i_sw) = exp( ( c_ocean_albedo(3)*am1 + c_ocean_albedo(2) )*am1 + c_ocean_albedo(1) )
    enddo
    enddo

    ! calculate tendency
    do j = js, je
    do i = is, ie
       sfc_albedo_t(i,j,i_lw) = 0.0_rp
       sfc_albedo_t(i,j,i_sw) = ( sfc_albedo1(i,j,i_sw) - sfc_albedo(i,j,i_sw) ) / dt
    enddo
    enddo

    return

Here is the caller graph for this function: