mod_ocean_driver.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scalelib.h"
module mod_ocean_driver
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
  use scale_prof
  use scale_ocean_grid_cartesc_index
  use scale_tracer
  use scale_cpl_sfc_index
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: ocean_driver_setup
  public :: ocean_driver_calc_tendency
  public :: ocean_driver_update
  public :: ocean_surface_get
  public :: ocean_surface_set

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  real(RP), private, allocatable :: qvef(:,:)
  real(RP), private, allocatable :: sr  (:,:)

  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine ocean_driver_setup
    use scale_prc, only: &
       prc_abort
    use mod_ocean_admin, only: &
       ocean_do,       &
       ocean_dyn_type, &
       ocean_sfc_type, &
       ocean_ice_type, &
       ocean_alb_type, &
       ocean_rgn_type
    use scale_cpl_phy_sfc_fixed_temp, only: &
       cpl_phy_sfc_fixed_temp_setup
    use scale_ocean_dyn_slab, only: &
       ocean_dyn_slab_setup
    use scale_ocean_dyn_offline, only: &
       ocean_dyn_offline_setup
    use scale_ocean_phy_ice_simple, only: &
       ocean_phy_ice_setup
    use scale_ocean_phy_albedo, only: &
       ocean_phy_albedo_const_setup, &
       ocean_phy_albedo_seaice_setup
    use scale_ocean_phy_albedo_nakajima00, only: &
       ocean_phy_albedo_nakajima00_setup
    use scale_ocean_phy_roughness, only: &
       ocean_phy_roughness_const_setup, &
       ocean_phy_roughness_seaice_setup
    use scale_ocean_phy_roughness_miller92, only: &
       ocean_phy_roughness_miller92_setup
    use scale_ocean_phy_roughness_moon07, only: &
       ocean_phy_roughness_moon07_setup
    use scale_ocean_phy_tc, only: &
       ocean_phy_tc_seaice_setup
    implicit none
    !---------------------------------------------------------------------------

    log_newline
    log_info("OCEAN_driver_setup",*) 'Setup'

    if ( ocean_do ) then

       select case ( ocean_dyn_type )
       case ( 'SLAB' )
          call ocean_dyn_slab_setup
       case ( 'OFFLINE' )
          call ocean_dyn_offline_setup
       case ( 'INIT' )
          ! do nothing
       case default
          log_error("OCEAN_driver_setup",*) 'OCEAN_DYN_TYPE is invalid: ', trim(ocean_dyn_type)
          call prc_abort
       end select

       select case ( ocean_sfc_type )
       case ( 'FIXED-TEMP' )
          call cpl_phy_sfc_fixed_temp_setup
       case default
          log_error("OCEAN_driver_setup",*) 'OCEAN_SFC_TYPE is invalid: ', trim(ocean_sfc_type)
          call prc_abort
       end select

       select case ( ocean_ice_type )
       case ( 'NONE' )
          ! do nothing
       case ( 'SIMPLE' )
          call ocean_phy_ice_setup
       case ( 'INIT' )
          ! do nothing
       case default
          log_error("OCEAN_driver_setup",*) 'OCEAN_ICE_TYPE is invalid: ', trim(ocean_ice_type)
          call prc_abort
       end select

       ! surface albedo
       select case ( ocean_alb_type )
       case ( 'NAKAJIMA00' )
          call ocean_phy_albedo_const_setup
          call ocean_phy_albedo_nakajima00_setup
          call ocean_phy_albedo_seaice_setup
       case ( 'CONST' )
          call ocean_phy_albedo_const_setup
       case ( 'INIT' )
          ! do nothing
       case default
          log_error("OCEAN_driver_setup",*) 'OCEAN_ALB_TYPE is invalid: ', trim(ocean_alb_type)
          call prc_abort
       end select

       ! surface roughness length
       select case ( ocean_rgn_type )
       case ( 'MILLER92' )
          call ocean_phy_roughness_miller92_setup
          call ocean_phy_roughness_seaice_setup
       case ( 'MOON07' )
          call ocean_phy_roughness_moon07_setup
          call ocean_phy_roughness_seaice_setup
       case ( 'CONST' )
          call ocean_phy_roughness_const_setup
       case ( 'INIT' )
          ! do nothing
       case default
          log_error("OCEAN_driver_setup",*) 'OCEAN_RGN_TYPE is invalid: ', trim(ocean_rgn_type)
          call prc_abort
       end select

       ! thermal conductivity
       call ocean_phy_tc_seaice_setup

       allocate( qvef(oia,oja) )
       allocate( sr(oia,oja) )
       qvef(:,:) = 1.0_rp
       sr(:,:) = 0.0_rp

    endif

    return
  end subroutine ocean_driver_setup

  !-----------------------------------------------------------------------------
  subroutine ocean_driver_calc_tendency( force )
    use scale_time, only: &
       dt => time_dtsec_ocean
    use scale_statistics, only: &
       statistics_checktotal, &
       statistics_total
    use scale_landuse, only: &
       exists_ocean => landuse_exists_ocean
    use scale_file_history, only: &
       file_history_in
    use scale_atmos_grid_cartesc_real, only: &
       real_z1 => atmos_grid_cartesc_real_z1
    use scale_atmos_hydrometeor, only: &
       hydrometeor_lhv => atmos_hydrometeor_lhv, &
       hydrometeor_lhs => atmos_hydrometeor_lhs, &
       atmos_hydrometeor_dry,                    &
       i_qv
    use scale_ocean_grid_cartesc_real, only: &
       ocean_grid_cartesc_real_vol,    &
       ocean_grid_cartesc_real_totvol, &
       ocean_grid_cartesc_real_area,   &
       ocean_grid_cartesc_real_totarea
    use scale_ocean_grid_cartesc_real, only: &
       ocean_grid_cartesc_real_area, &
       ocean_grid_cartesc_real_totarea
    use scale_cpl_phy_sfc_fixed_temp, only: &
       cpl_phy_sfc_fixed_temp
    use scale_ocean_phy_albedo, only: &
       ocean_phy_albedo_const, &
       ocean_phy_albedo_seaice
    use scale_ocean_phy_albedo_nakajima00, only: &
       ocean_phy_albedo_nakajima00
    use scale_ocean_phy_roughness, only: &
       ocean_phy_roughness_const, &
       ocean_phy_roughness_seaice
    use scale_ocean_phy_roughness_miller92, only: &
       ocean_phy_roughness_miller92
    use scale_ocean_phy_roughness_moon07, only: &
       ocean_phy_roughness_moon07
    use scale_ocean_phy_tc, only: &
       ocean_phy_tc_seaice
    use scale_ocean_phy_ice_simple, only: &
       ocean_phy_ice_simple
    use mod_atmos_admin, only: &
       atmos_sw_phy_ch
    use mod_atmos_phy_ch_driver, only: &
       atmos_phy_ch_driver_ocean_flux
    use mod_ocean_admin, only: &
       ocean_sfc_type, &
       ocean_ice_type, &
       ocean_alb_type, &
       ocean_rgn_type
    use mod_ocean_vars, only: &
       ocean_temp,        &
       ocean_ocn_z0m,     &
       ocean_ice_temp,    &
       ocean_ice_mass,    &
       ocean_sfc_temp,    &
       ocean_sfc_albedo,  &
       ocean_sfc_z0m,     &
       ocean_sfc_z0h,     &
       ocean_sfc_z0e,     &
       ocean_temp_t,      &
       ocean_salt_t,      &
       ocean_uvel_t,      &
       ocean_vvel_t,      &
       ocean_ice_temp_t,  &
       ocean_ice_mass_t,  &
       atmos_temp,        &
       atmos_pres,        &
       atmos_w,           &
       atmos_u,           &
       atmos_v,           &
       atmos_dens,        &
       atmos_qv,          &
       atmos_pbl,         &
       atmos_cossza,      &
       atmos_sfc_dens,    &
       atmos_sfc_pres,    &
       atmos_sflx_rad_dn, &
       atmos_sflx_rain,   &
       atmos_sflx_snow,   &
       ocean_sflx_mw,     &
       ocean_sflx_mu,     &
       ocean_sflx_mv,     &
       ocean_sflx_sh,     &
       ocean_sflx_lh,     &
       ocean_sflx_qtrc,   &
       ocean_u10,         &
       ocean_v10,         &
       ocean_t2,          &
       ocean_q2,          &
       ocean_sflx_g,      &
       ocean_sflx_water,  &
       ocean_sflx_ice,    &
       ocean_ice_frac, &
       ocean_vars_total
    implicit none

    logical, intent(in) :: force

    real(RP) :: LHV          (oia,oja) ! latent heat of vaporization [J/kg]
    real(RP) :: LHS          (oia,oja) ! latent heat of sublimation  [J/kg]
    real(RP) :: ATMOS_Uabs   (oia,oja)
    real(RP) :: sfc_frac     (oia,oja)
    real(RP) :: sfc_temp     (oia,oja)
    real(RP) :: sfc_albedo   (oia,oja,n_rad_dir,n_rad_rgn)
    real(RP) :: sfc_Z0M      (oia,oja)
    real(RP) :: sfc_Z0H      (oia,oja)
    real(RP) :: sfc_Z0E      (oia,oja)
    real(RP) :: subsfc_temp  (oia,oja)
    real(RP) :: TC_dz        (oia,oja)
    real(RP) :: sflx_MW      (oia,oja)
    real(RP) :: sflx_MU      (oia,oja)
    real(RP) :: sflx_MV      (oia,oja)
    real(RP) :: sflx_SH      (oia,oja)
    real(RP) :: sflx_QV      (oia,oja)
    real(RP) :: U10          (oia,oja)
    real(RP) :: V10          (oia,oja)
    real(RP) :: T2           (oia,oja)
    real(RP) :: Q2           (oia,oja)
    real(RP) :: sflx_hbalance(oia,oja)
    real(RP) :: sflx_G       (oia,oja)
    real(RP) :: sflx_water   (oia,oja)
    real(RP) :: sflx_ice     (oia,oja)
    logical  :: exists_ice   (oia,oja)

    integer  :: k, i, j, iq, idir, irgn
    !---------------------------------------------------------------------------

    call prof_rapstart('OCN_CalcTend', 1)

    !########## Get Surface Boundary from coupler ##########
    call ocean_surface_get

    call hydrometeor_lhv( oia, ois, oie, oja, ojs, oje, & ! [IN]
                          atmos_temp(:,:),              & ! [IN]
                          lhv(:,:)               ) ! [OUT]
    call hydrometeor_lhs( oia, ois, oie, oja, ojs, oje, & ! [IN]
                          atmos_temp(:,:),              & ! [IN]
                          lhs(:,:)               ) ! [OUT]

    !$omp parallel do
    do j = ojs, oje
    do i = ois, oie
       atmos_uabs(i,j) = sqrt( atmos_u(i,j)**2 + atmos_v(i,j)**2 )
    enddo
    enddo

    !$omp parallel do
    do j = ojs, oje
    do i = ois, oie
       exists_ice(i,j) = .false.
       if( exists_ocean(i,j) .AND. ocean_ice_frac(i,j) > 0.0_rp ) exists_ice(i,j) = .true.
    enddo
    enddo

    !########## reset tendencies ##########

    !$omp parallel do
    do j = ojs, oje
    do i = ois, oie
    do k = oks, oke
       ocean_temp_t(k,i,j) = 0.0_rp
       ocean_salt_t(k,i,j) = 0.0_rp
       ocean_uvel_t(k,i,j) = 0.0_rp
       ocean_vvel_t(k,i,j) = 0.0_rp
    enddo
    enddo
    enddo

    !$omp parallel do
    do j = ojs, oje
    do i = ois, oie
       ocean_ice_temp_t(i,j) = 0.0_rp
       ocean_ice_mass_t(i,j) = 0.0_rp
    enddo
    enddo

    do iq = 1, qa
    !$omp parallel do
    do j  = ojs, oje
    do i  = ois, oie
       ocean_sflx_qtrc(i,j,iq) = 0.0_rp
    enddo
    enddo
    enddo



    !########## surface process (ice-free ocean) ##########

    !$omp parallel do
    do j = ojs, oje
    do i = ois, oie
       sfc_frac(i,j) = 1.0_rp - ocean_ice_frac(i,j)
       sfc_temp(i,j) = ocean_temp(oks,i,j)
    enddo
    enddo

    ! albedo
    select case ( ocean_alb_type )
    case ( 'NAKAJIMA00' )
       ! for Near-IR, IR
       call ocean_phy_albedo_const     ( oia, ois, oie,        & ! [IN]
                                         oja, ojs, oje,        & ! [IN]
                                         sfc_albedo(:,:,:,:) ) ! [OUT]
       ! for VIS (overwrite)
       call ocean_phy_albedo_nakajima00( oia, ois, oie,              & ! [IN]
                                         oja, ojs, oje,              & ! [IN]
                                         atmos_cossza(:,:),          & ! [IN]
                                         sfc_albedo(:,:,:,i_r_vis) ) ! [OUT]
    case ( 'CONST' )
       call ocean_phy_albedo_const     ( oia, ois, oie,        & ! [IN]
                                         oja, ojs, oje,        & ! [IN]
                                         sfc_albedo(:,:,:,:) ) ! [OUT]
    case ( 'INIT' )
       ! Never update OCEAN_SFC_albedo from initial condition
       do irgn = i_r_ir, i_r_vis
       do idir = i_r_direct, i_r_diffuse
       do j    = ojs, oje
       do i    = ois, oie
          sfc_albedo(i,j,idir,irgn) = ocean_sfc_albedo(i,j,idir,irgn)
       enddo
       enddo
       enddo
       enddo
    end select

    ! roughness length
    select case ( ocean_rgn_type )
    case ( 'MILLER92' )
       call ocean_phy_roughness_miller92( oia, ois, oie,   & ! [IN]
                                          oja, ojs, oje,   & ! [IN]
                                          atmos_uabs(:,:), & ! [IN]
                                          sfc_z0m(:,:), & ! [OUT]
                                          sfc_z0h(:,:), & ! [OUT]
                                          sfc_z0e(:,:)  ) ! [OUT]
    case ( 'MOON07' )
       call ocean_phy_roughness_moon07  ( oia, ois, oie,      & ! [IN]
                                          oja, ojs, oje,      & ! [IN]
                                          atmos_uabs(:,:), & ! [IN]
                                          real_z1(:,:), & ! [IN]
                                          ocean_ocn_z0m(:,:), & ! [INOUT]
                                          sfc_z0h(:,:), & ! [OUT]
                                          sfc_z0e(:,:)  ) ! [OUT]

       !$omp parallel do
       do j = ojs, oje
       do i = ois, oie
          sfc_z0m(i,j) = ocean_ocn_z0m(i,j)
       enddo
       enddo
    case ( 'CONST' )
       call ocean_phy_roughness_const   ( oia, ois, oie,   & ! [IN]
                                          oja, ojs, oje,   & ! [IN]
                                          sfc_z0m(:,:), & ! [OUT]
                                          sfc_z0h(:,:), & ! [OUT]
                                          sfc_z0e(:,:)  ) ! [OUT]
    case ( 'INIT' )
       ! Never update OCEAN_SFC_Z0M/H/E from initial condition
       !$omp parallel do
       do j = ojs, oje
       do i = ois, oie
          sfc_z0m(i,j) = ocean_sfc_z0m(i,j)
          sfc_z0h(i,j) = ocean_sfc_z0h(i,j)
          sfc_z0e(i,j) = ocean_sfc_z0e(i,j)
       enddo
       enddo
    end select

    ! tendency
    select case ( ocean_sfc_type )
    case ( 'FIXED-TEMP' )
       call cpl_phy_sfc_fixed_temp( oia, ois, oie,              & ! [IN]
                                    oja, ojs, oje,              & ! [IN]
                                    atmos_temp(:,:),     & ! [IN]
                                    atmos_pres(:,:),     & ! [IN]
                                    atmos_w(:,:),     & ! [IN]
                                    atmos_u(:,:),     & ! [IN]
                                    atmos_v(:,:),     & ! [IN]
                                    atmos_dens(:,:),     & ! [IN]
                                    atmos_qv(:,:),     & ! [IN]
                                    lhv(:,:),     & ! [IN]
                                    real_z1(:,:),     & ! [IN]
                                    atmos_pbl(:,:),     & ! [IN]
                                    atmos_sfc_dens(:,:),     & ! [IN]
                                    atmos_sfc_pres(:,:),     & ! [IN]
                                    atmos_sflx_rad_dn(:,:,:,:), & ! [IN]
                                    sfc_temp(:,:),     & ! [IN]
                                    qvef(:,:),     & ! [IN]
                                    sfc_albedo(:,:,:,:), & ! [IN]
                                    sr(:,:),     & ! [IN]
                                    sfc_z0m(:,:),     & ! [IN]
                                    sfc_z0h(:,:),     & ! [IN]
                                    sfc_z0e(:,:),     & ! [IN]
                                    exists_ocean(:,:),     & ! [IN]
                                    dt,                         & ! [IN]
                                    sflx_mw(:,:),     & ! [OUT]
                                    sflx_mu(:,:),     & ! [OUT]
                                    sflx_mv(:,:),     & ! [OUT]
                                    sflx_sh(:,:),     & ! [OUT]
                                    sflx_qv(:,:),     & ! [OUT]
                                    sflx_g(:,:),     & ! [OUT]
                                    u10(:,:),     & ! [OUT]
                                    v10(:,:),     & ! [OUT]
                                    t2(:,:),     & ! [OUT]
                                    q2(:,:)      ) ! [OUT]
    end select

    !$omp parallel do
    do j = ojs, oje
    do i = ois, oie
       sflx_water(i,j) = atmos_sflx_rain(i,j) - sflx_qv(i,j)
       sflx_ice(i,j) = atmos_sflx_snow(i,j)
    enddo
    enddo

    ! weighted average

    !$omp parallel do
    do j = ojs, oje
    do i = ois, oie
       ocean_sfc_temp(i,j) = sfc_temp(i,j) * sfc_frac(i,j)
       ocean_sfc_z0m(i,j) = sfc_z0m(i,j) * sfc_frac(i,j)
       ocean_sfc_z0h(i,j) = sfc_z0h(i,j) * sfc_frac(i,j)
       ocean_sfc_z0e(i,j) = sfc_z0e(i,j) * sfc_frac(i,j)
       ocean_sflx_mw(i,j) = sflx_mw(i,j) * sfc_frac(i,j)
       ocean_sflx_mu(i,j) = sflx_mu(i,j) * sfc_frac(i,j)
       ocean_sflx_mv(i,j) = sflx_mv(i,j) * sfc_frac(i,j)
       ocean_sflx_sh(i,j) = sflx_sh(i,j) * sfc_frac(i,j)
       ocean_u10(i,j) = u10(i,j) * sfc_frac(i,j)
       ocean_v10(i,j) = v10(i,j) * sfc_frac(i,j)
       ocean_t2(i,j) = t2(i,j) * sfc_frac(i,j)
       ocean_q2(i,j) = q2(i,j) * sfc_frac(i,j)

       ocean_sflx_g(i,j) = sflx_g(i,j) * sfc_frac(i,j) * (-1.0_rp) ! upward to downward
       ocean_sflx_water(i,j) = sflx_water(i,j) * sfc_frac(i,j)
       ocean_sflx_ice(i,j) = sflx_ice(i,j) * sfc_frac(i,j)
    enddo
    enddo

    if ( .NOT. atmos_hydrometeor_dry ) then
       !$omp parallel do
       do j = ojs, oje
       do i = ois, oie
          ocean_sflx_qtrc(i,j,i_qv) = sflx_qv(i,j) * sfc_frac(i,j)
       enddo
       enddo
    endif

    !$omp parallel do
    do irgn = i_r_ir, i_r_vis
    do idir = i_r_direct, i_r_diffuse
    do j    = ojs, oje
    do i    = ois, oie
       ocean_sfc_albedo(i,j,idir,irgn) = sfc_albedo(i,j,idir,irgn) * sfc_frac(i,j)
    enddo
    enddo
    enddo
    enddo



    !########## surface process (ice) ##########

    if ( ocean_ice_type /= 'NONE' ) then

       !$omp parallel do
       do j = ojs, oje
       do i = ois, oie
          sfc_frac(i,j) = ocean_ice_frac(i,j)
          sfc_temp(i,j) = ocean_ice_temp(i,j)
          subsfc_temp(i,j) = ocean_temp(oks,i,j)
       enddo
       enddo

       ! albedo
       select case ( ocean_alb_type )
       case ( 'NAKAJIMA00' )
          call ocean_phy_albedo_seaice( oia, ois, oie,      & ! [IN]
                                        oja, ojs, oje,      & ! [IN]
                                        sfc_albedo(:,:,:,:) ) ! [OUT]
       case ( 'CONST' )
          call ocean_phy_albedo_const ( oia, ois, oie,      & ! [IN]
                                        oja, ojs, oje,      & ! [IN]
                                        sfc_albedo(:,:,:,:) ) ! [OUT]
       case ( 'INIT' )
          ! Never update OCEAN_SFC_albedo from initial condition
          do irgn = i_r_ir, i_r_vis
          do idir = i_r_direct, i_r_diffuse
          do j    = ojs, oje
          do i    = ois, oie
             sfc_albedo(i,j,idir,irgn) = ocean_sfc_albedo(i,j,idir,irgn)
          enddo
          enddo
          enddo
          enddo
       end select

       ! roughness length
       select case ( ocean_rgn_type )
       case ( 'MILLER92', 'MOON07' )
          call ocean_phy_roughness_seaice( oia, ois, oie, & ! [IN]
                                           oja, ojs, oje, & ! [IN]
                                           sfc_z0m(:,:),  & ! [OUT]
                                           sfc_z0h(:,:),  & ! [OUT]
                                           sfc_z0e(:,:)   ) ! [OUT]
       case ( 'CONST' )
          call ocean_phy_roughness_const ( oia, ois, oie, & ! [IN]
                                           oja, ojs, oje, & ! [IN]
                                           sfc_z0m(:,:),  & ! [OUT]
                                           sfc_z0h(:,:),  & ! [OUT]
                                           sfc_z0e(:,:)   ) ! [OUT]
       case ( 'INIT' )
          ! Never update OCEAN_SFC_Z0M/H/E from initial condition
          !$omp parallel do
          do j = ojs, oje
          do i = ois, oie
             sfc_z0m(i,j) = ocean_sfc_z0m(i,j)
             sfc_z0h(i,j) = ocean_sfc_z0h(i,j)
             sfc_z0e(i,j) = ocean_sfc_z0e(i,j)
          enddo
          enddo
       end select

       ! thermal conductivity / depth
       call ocean_phy_tc_seaice( oia, ois, oie,       & ! [IN]
                                 oja, ojs, oje,       & ! [IN]
                                 ocean_ice_mass(:,:), & ! [IN]
                                 ocean_ice_frac(:,:), & ! [IN]
                                 tc_dz(:,:)  ) ! [OUT]

       ! tendency
       select case ( ocean_sfc_type )
       case ( 'FIXED-TEMP' )
          call cpl_phy_sfc_fixed_temp( oia, ois, oie,              & ! [IN]
                                       oja, ojs, oje,              & ! [IN]
                                       atmos_temp(:,:),     & ! [IN]
                                       atmos_pres(:,:),     & ! [IN]
                                       atmos_w(:,:),     & ! [IN]
                                       atmos_u(:,:),     & ! [IN]
                                       atmos_v(:,:),     & ! [IN]
                                       atmos_dens(:,:),     & ! [IN]
                                       atmos_qv(:,:),     & ! [IN]
                                       lhs(:,:),     & ! [IN]
                                       real_z1(:,:),     & ! [IN]
                                       atmos_pbl(:,:),     & ! [IN]
                                       atmos_sfc_dens(:,:),     & ! [IN]
                                       atmos_sfc_pres(:,:),     & ! [IN]
                                       atmos_sflx_rad_dn(:,:,:,:), & ! [IN]
                                       sfc_temp(:,:),     & ! [IN]
                                       qvef(:,:),     & ! [IN]
                                       sfc_albedo(:,:,:,:), & ! [IN]
                                       sr(:,:),     & ! [IN]
                                       sfc_z0m(:,:),     & ! [IN]
                                       sfc_z0h(:,:),     & ! [IN]
                                       sfc_z0e(:,:),     & ! [IN]
                                       exists_ice(:,:),     & ! [IN]
                                       dt,                         & ! [IN]
                                       sflx_mw(:,:),     & ! [OUT]
                                       sflx_mu(:,:),     & ! [OUT]
                                       sflx_mv(:,:),     & ! [OUT]
                                       sflx_sh(:,:),     & ! [OUT]
                                       sflx_qv(:,:),     & ! [OUT]
                                       sflx_g(:,:),     & ! [OUT]
                                       u10(:,:),     & ! [OUT]
                                       v10(:,:),     & ! [OUT]
                                       t2(:,:),     & ! [OUT]
                                       q2(:,:)      ) ! [OUT]
       end select

       ! seaice
       select case ( ocean_ice_type )
       case ( 'SIMPLE' )

          !$omp parallel do
          do j = ojs, oje
          do i = ois, oie
             sflx_hbalance(i,j) = - sflx_g(i,j) ! upward to downward
          enddo
          enddo

          call ocean_phy_ice_simple( oia, ois, oie,         & ! [IN]
                                     oja, ojs, oje,         & ! [IN]
                                     sflx_qv(:,:), & ! [IN]
                                     atmos_sflx_rain(:,:), & ! [IN]
                                     atmos_sflx_snow(:,:), & ! [IN]
                                     sflx_hbalance(:,:), & ! [IN]
                                     subsfc_temp(:,:), & ! [IN]
                                     tc_dz(:,:), & ! [IN]
                                     ocean_ice_temp(:,:), & ! [IN]
                                     ocean_ice_mass(:,:), & ! [IN]
                                     exists_ice(:,:), & ! [IN]
                                     dt,                    & ! [IN]
                                     ocean_ice_temp_t(:,:), & ! [OUT]
                                     ocean_ice_mass_t(:,:), & ! [OUT]
                                     sflx_g(:,:), & ! [OUT]
                                     sflx_water(:,:), & ! [OUT]
                                     sflx_ice(:,:)  ) ! [OUT]
       case ( 'INIT' )
          !$omp parallel do
          do j = ojs, oje
          do i = ois, oie
             sflx_g(i,j) = - sflx_g(i,j) ! upward to downward
             sflx_water(i,j) = 0.0_rp ! no flux from seaice to ocean
             sflx_ice(i,j) = 0.0_rp ! no flux from seaice to ocean
          enddo
          enddo
       end select

       ! weighted average

       !$omp parallel do
       do j = ojs, oje
       do i = ois, oie
          ocean_sfc_temp(i,j) = ocean_sfc_temp(i,j) + sfc_temp(i,j) * sfc_frac(i,j)
          ocean_sfc_z0m(i,j) = ocean_sfc_z0m(i,j) + sfc_z0m(i,j) * sfc_frac(i,j)
          ocean_sfc_z0h(i,j) = ocean_sfc_z0h(i,j) + sfc_z0h(i,j) * sfc_frac(i,j)
          ocean_sfc_z0e(i,j) = ocean_sfc_z0e(i,j) + sfc_z0e(i,j) * sfc_frac(i,j)
          ocean_sflx_mw(i,j) = ocean_sflx_mw(i,j) + sflx_mw(i,j) * sfc_frac(i,j)
          ocean_sflx_mu(i,j) = ocean_sflx_mu(i,j) + sflx_mu(i,j) * sfc_frac(i,j)
          ocean_sflx_mv(i,j) = ocean_sflx_mv(i,j) + sflx_mv(i,j) * sfc_frac(i,j)
          ocean_sflx_sh(i,j) = ocean_sflx_sh(i,j) + sflx_sh(i,j) * sfc_frac(i,j)
          ocean_u10(i,j) = ocean_u10(i,j) + u10(i,j) * sfc_frac(i,j)
          ocean_v10(i,j) = ocean_v10(i,j) + v10(i,j) * sfc_frac(i,j)
          ocean_t2(i,j) = ocean_t2(i,j) + t2(i,j) * sfc_frac(i,j)
          ocean_q2(i,j) = ocean_q2(i,j) + q2(i,j) * sfc_frac(i,j)

          ocean_sflx_g(i,j) = ocean_sflx_g(i,j) + sflx_g(i,j) * sfc_frac(i,j)
          ocean_sflx_water(i,j) = ocean_sflx_water(i,j) + sflx_water(i,j) * sfc_frac(i,j)
          ocean_sflx_ice(i,j) = ocean_sflx_ice(i,j) + sflx_ice(i,j) * sfc_frac(i,j)
       enddo
       enddo

       if ( .NOT. atmos_hydrometeor_dry ) then
          !$omp parallel do
          do j = ojs, oje
          do i = ois, oie
             ocean_sflx_qtrc(i,j,i_qv) = ocean_sflx_qtrc(i,j,i_qv) + sflx_qv(i,j) * sfc_frac(i,j)
          enddo
          enddo
       endif

       !$omp parallel do
       do irgn = i_r_ir, i_r_vis
       do idir = i_r_direct, i_r_diffuse
       do j    = ojs, oje
       do i    = ois, oie
          ocean_sfc_albedo(i,j,idir,irgn) = ocean_sfc_albedo(i,j,idir,irgn) + sfc_albedo(i,j,idir,irgn) * sfc_frac(i,j)
       enddo
       enddo
       enddo
       enddo

    endif ! ICE process?

    if ( .NOT. atmos_hydrometeor_dry ) then
       !$omp parallel do
       do j = ojs, oje
       do i = ois, oie
          ocean_sflx_lh(i,j) = ocean_sflx_qtrc(i,j,i_qv) * lhv(i,j) ! always LHV
       enddo
       enddo
    else
       !$omp parallel do
       do j = ojs, oje
       do i = ois, oie
          ocean_sflx_lh(i,j) = 0.0_rp
       enddo
       enddo
    endif

    ! Surface flux for chemical tracers
    if ( atmos_sw_phy_ch ) then
       call atmos_phy_ch_driver_ocean_flux( ocean_sflx_qtrc(:,:,:) ) ! [INOUT]
    endif

    if ( statistics_checktotal ) then
       call statistics_total( oka, oks, oke, oia, ois, oie, oja, ojs, oje, &
                              ocean_temp_t(:,:,:), 'OCEAN_TEMP_t',         &
                              ocean_grid_cartesc_real_vol(:,:,:),          &
                              ocean_grid_cartesc_real_totvol               )
       call statistics_total( oia, ois, oie, oja, ojs, oje,                &
                              ocean_ice_temp_t(:,:), 'OCEAN_ICE_TEMP_t',   &
                              ocean_grid_cartesc_real_area(:,:),           &
                              ocean_grid_cartesc_real_totarea              )
       call statistics_total( oia, ois, oie, oja, ojs, oje,                &
                              ocean_ice_mass_t(:,:), 'OCEAN_ICE_MASS_t',   &
                              ocean_grid_cartesc_real_area(:,:),           &
                              ocean_grid_cartesc_real_totarea              )
    endif

    !########## Set Surface Boundary to coupler ##########
    call ocean_surface_set( countup=.true. )

    call prof_rapend  ('OCN_CalcTend', 1)

    return
  end subroutine ocean_driver_calc_tendency

  !-----------------------------------------------------------------------------
  subroutine ocean_driver_update
    use scale_time, only: &
       nowdaysec => time_nowdaysec,  &
       dt        => time_dtsec_ocean
    use scale_landuse, only: &
       exists_ocean => landuse_exists_ocean
    use mod_ocean_admin, only: &
       ocean_dyn_type, &
       ocean_ice_type
    use mod_ocean_vars, only: &
       ocean_temp,         &
       ocean_salt,         &
       ocean_uvel,         &
       ocean_vvel,         &
       ocean_ice_temp,     &
       ocean_ice_mass,     &
       ocean_ice_frac,     &
       ocean_temp_t,       &
       ocean_salt_t,       &
       ocean_uvel_t,       &
       ocean_vvel_t,       &
       ocean_ice_temp_t,   &
       ocean_ice_mass_t,   &
       ocean_sflx_g,       &
       ocean_sflx_water,   &
       ocean_sflx_ice,     &
       ocean_vars_total,   &
       ocean_vars_history
    use scale_ocean_dyn_slab, only: &
       ocean_dyn_slab, &
       ocean_dyn_slab_depth
    use scale_ocean_dyn_offline, only: &
       ocean_dyn_offline
    use scale_ocean_phy_ice_simple, only: &
       ocean_phy_ice_adjustment, &
       ocean_phy_ice_fraction
    implicit none

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

    call prof_rapstart('OCN_Update', 2)

    !########## Get Surface Boundary from coupler ##########
    call ocean_surface_get

    !########## Dynamics / Update ##########
    select case ( ocean_dyn_type )
    case ( 'SLAB' )

       call ocean_dyn_slab( okmax, oks, oke,         & ! [IN]
                            oia,   ois, oie,         & ! [IN]
                            oja,   ojs, oje,         & ! [IN]
                            ocean_temp_t(:,:,:), & ! [IN]
                            ocean_sflx_g(:,:),   & ! [IN]
                            ocean_sflx_water(:,:),   & ! [IN]
                            ocean_sflx_ice(:,:),   & ! [IN]
                            exists_ocean(:,:),   & ! [IN]
                            dt, nowdaysec,           & ! [IN]
                            ocean_temp(:,:,:)  ) ! [INOUT]

    case ( 'OFFLINE' )

       call ocean_dyn_offline( okmax, oks, oke,         & ! [IN]
                               oia,   ois, oie,         & ! [IN]
                               oja,   ojs, oje,         & ! [IN]
                               exists_ocean(:,:),   & ! [IN]
                               dt, nowdaysec,           & ! [IN]
                               ocean_temp(:,:,:)  ) ! [INOUT]

    case ( 'INIT' )
       ! Never update OCEAN_TEMP from initial condition
    end select

    !########## Ice / Update ##########
    select case ( ocean_ice_type )
    case ( 'SIMPLE' )

       !$omp parallel do
       do j = ojs, oje
       do i = ois, oie
          ocean_ice_temp(i,j) = ocean_ice_temp(i,j) + ocean_ice_temp_t(i,j) * dt
          ocean_ice_mass(i,j) = ocean_ice_mass(i,j) + ocean_ice_mass_t(i,j) * dt
       enddo
       enddo

       ! ice adjustment
       call ocean_phy_ice_adjustment( oia, ois, oie,           & ! [IN]
                                      oja, ojs, oje,           & ! [IN]
                                      exists_ocean(:,:),     & ! [IN]
                                      ocean_dyn_slab_depth,    & ! [IN]
                                      ocean_temp(oks,:,:), & ! [INOUT]
                                      ocean_ice_temp(:,:),     & ! [INOUT]
                                      ocean_ice_mass(:,:)      ) ! [INOUT]

       ! update ice fraction
       call ocean_phy_ice_fraction( oia, ois, oie,       & ! [IN]
                                    oja, ojs, oje,       & ! [IN]
                                    ocean_ice_mass(:,:), & ! [IN]
                                    ocean_ice_frac(:,:)  ) ! [OUT]

    case ( 'INIT' )
       ! Never update OCEAN_ICE_TEMP, OCEAN_ICE_MASS, OCEAN_ICE_FRAC from initial condition
    end select

    call ocean_vars_total

    !########## History & Monitor ##########
    call ocean_vars_history

    call prof_rapend  ('OCN_Update', 2)

    return
  end subroutine ocean_driver_update

  !-----------------------------------------------------------------------------
  subroutine ocean_surface_get
    use mod_ocean_admin, only: &
       ocean_do
    use mod_ocean_vars, only: &
       atmos_temp,        &
       atmos_pres,        &
       atmos_w,           &
       atmos_u,           &
       atmos_v,           &
       atmos_dens,        &
       atmos_qv,          &
       atmos_pbl,         &
       atmos_sfc_dens,    &
       atmos_sfc_pres,    &
       atmos_sflx_rad_dn, &
       atmos_cossza,      &
       atmos_sflx_rain,   &
       atmos_sflx_snow
    use mod_cpl_vars, only: &
       cpl_getatm_ocn
    implicit none
    !---------------------------------------------------------------------------

    call prof_rapstart('OCN_SfcExch', 2)

    if ( ocean_do ) then
       call cpl_getatm_ocn( atmos_temp(:,:),     & ! [OUT]
                            atmos_pres(:,:),     & ! [OUT]
                            atmos_w(:,:),     & ! [OUT]
                            atmos_u(:,:),     & ! [OUT]
                            atmos_v(:,:),     & ! [OUT]
                            atmos_dens(:,:),     & ! [OUT]
                            atmos_qv(:,:),     & ! [OUT]
                            atmos_pbl(:,:),     & ! [OUT]
                            atmos_sfc_dens(:,:),     & ! [OUT]
                            atmos_sfc_pres(:,:),     & ! [OUT]
                            atmos_sflx_rad_dn(:,:,:,:), & ! [OUT]
                            atmos_cossza(:,:),     & ! [OUT]
                            atmos_sflx_rain(:,:),     & ! [OUT]
                            atmos_sflx_snow(:,:)      ) ! [OUT]
    endif

    call prof_rapend  ('OCN_SfcExch', 2)

    return
  end subroutine ocean_surface_get

  !-----------------------------------------------------------------------------
  subroutine ocean_surface_set( countup )
    use mod_ocean_admin, only: &
       ocean_do
    use mod_ocean_vars, only: &
       ocean_sfc_temp,   &
       ocean_sfc_albedo, &
       ocean_sfc_z0m,    &
       ocean_sfc_z0h,    &
       ocean_sfc_z0e,    &
       ocean_sflx_mw,    &
       ocean_sflx_mu,    &
       ocean_sflx_mv,    &
       ocean_sflx_sh,    &
       ocean_sflx_lh,    &
       ocean_sflx_qtrc,  &
       ocean_u10,        &
       ocean_v10,        &
       ocean_t2,         &
       ocean_q2,         &
       ocean_sflx_g
    use mod_cpl_vars, only: &
       cpl_putocn
    implicit none

    logical, intent(in) :: countup
    !---------------------------------------------------------------------------

    call prof_rapstart('OCN_SfcExch', 2)

    if ( ocean_do ) then
       call cpl_putocn( ocean_sfc_temp(:,:),     & ! [IN]
                        ocean_sfc_albedo(:,:,:,:), & ! [IN]
                        ocean_sfc_z0m(:,:),     & ! [IN]
                        ocean_sfc_z0h(:,:),     & ! [IN]
                        ocean_sfc_z0e(:,:),     & ! [IN]
                        ocean_sflx_mw(:,:),     & ! [IN]
                        ocean_sflx_mu(:,:),     & ! [IN]
                        ocean_sflx_mv(:,:),     & ! [IN]
                        ocean_sflx_sh(:,:),     & ! [IN]
                        ocean_sflx_lh(:,:),     & ! [IN]
                        ocean_sflx_g(:,:),     & ! [IN]
                        ocean_sflx_qtrc(:,:,:),   & ! [IN]
                        ocean_u10(:,:),     & ! [IN]
                        ocean_v10(:,:),     & ! [IN]
                        ocean_t2(:,:),     & ! [IN]
                        ocean_q2(:,:),     & ! [IN]
                        countup                    ) ! [IN]
    endif

    call prof_rapend  ('OCN_SfcExch', 2)

    return
  end subroutine ocean_surface_set

end module mod_ocean_driver