mod_ocean_driver.f90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
module mod_ocean_driver
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_stdio
  use scale_prof
  use scale_debug
  use scale_grid_index

  use scale_const, only: &
     i_sw  => const_i_sw, &
     i_lw  => const_i_lw
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: ocean_driver_setup
  public :: ocean_driver_resume
  public :: ocean_driver
  public :: ocean_surface_get
  public :: ocean_surface_set

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine ocean_driver_setup
    use mod_ocean_phy_driver, only: &
       ocean_phy_driver_setup
!    use mod_ocean_frc_nudge, only: &
!       OCEAN_FRC_driver_setup
    implicit none
    !---------------------------------------------------------------------------

    if( io_l ) write(io_fid_log,*)
    if( io_l ) write(io_fid_log,*) '++++++ Module[DRIVER] / Categ[OCEAN] / Origin[SCALE-RM]'

    call ocean_phy_driver_setup

!    if( OCEAN_FRC_sw ) call OCEAN_FRC_driver_setup

    return
  end subroutine ocean_driver_setup

  !-----------------------------------------------------------------------------
  subroutine ocean_driver_resume
    use mod_ocean_phy_driver, only: &
       ocean_phy_driver_resume
!    use mod_ocean_frc_nudge, only: &
!       OCEAN_FRC_driver_resume
    use mod_ocean_vars, only: &
       ocean_vars_history
    use mod_ocean_admin, only: &
       ocean_sw
    implicit none
    !---------------------------------------------------------------------------

    if( io_l ) write(io_fid_log,*)
    if( io_l ) write(io_fid_log,*) '++++++ Module[DRIVER] / Categ[OCEAN] / Origin[SCALE-RM]'

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

    call ocean_phy_driver_resume

!    if( OCEAN_FRC_sw ) call OCEAN_FRC_driver_resume

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

    !########## History & Monitor ##########
    if ( ocean_sw ) then
       call prof_rapstart('OCN_History', 1)
       call ocean_vars_history
       call prof_rapend  ('OCN_History', 1)
    endif

    return
  end subroutine ocean_driver_resume

  !-----------------------------------------------------------------------------
  subroutine ocean_driver
    use scale_time, only: &
       dt => time_dtsec_ocean
    use mod_ocean_admin, only: &
       ocean_sw
    use mod_ocean_vars, only: &
       ocean_temp,         &
       ocean_sfc_temp,     &
       ocean_sfc_albedo,   &
       ocean_sfc_z0m,      &
       ocean_sfc_z0h,      &
       ocean_sfc_z0e,      &
       ocean_temp_t,       &
       ocean_sfc_temp_t,   &
       ocean_sfc_albedo_t, &
       ocean_sfc_z0m_t,    &
       ocean_sfc_z0h_t,    &
       ocean_sfc_z0e_t,    &
       ocean_vars_total,   &
       ocean_vars_history
    use mod_ocean_phy_driver, only: &
       ocean_phy_driver
!    use mod_ocean_forcing, only: &
!       OCEAN_forcing
    implicit none

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

    !########## Get Surface Boundary from coupler ##########
    call prof_rapstart('OCN_SfcExch', 2)
    call ocean_surface_get
    call prof_rapend  ('OCN_SfcExch', 2)

    !########## Physics ##########
    if ( ocean_sw ) then
       call prof_rapstart('OCN_Physics', 1)
       call ocean_phy_driver( update_flag = .true. )
       call prof_rapend  ('OCN_Physics', 1)
    endif

    !########## Forcing ##########
!    if ( OCEAN_FORCE_sw ) then
!       call PROF_rapstart('OCN_Forcing', 1)
!       call OCEAN_forcing
!       call PROF_rapend  ('OCN_Forcing', 1)
!    endif

    !########## Update ##########
    do j = js, je
    do i = is, ie
       ocean_temp(i,j)      = ocean_temp(i,j)      + ocean_temp_t(i,j)      * dt
       ocean_sfc_temp(i,j)      = ocean_sfc_temp(i,j)      + ocean_sfc_temp_t(i,j)      * dt
       ocean_sfc_albedo(i,j,i_lw) = ocean_sfc_albedo(i,j,i_lw) + ocean_sfc_albedo_t(i,j,i_lw) * dt
       ocean_sfc_albedo(i,j,i_sw) = ocean_sfc_albedo(i,j,i_sw) + ocean_sfc_albedo_t(i,j,i_sw) * dt
       ocean_sfc_z0m(i,j)      = ocean_sfc_z0m(i,j)      + ocean_sfc_z0m_t(i,j)      * dt
       ocean_sfc_z0h(i,j)      = ocean_sfc_z0h(i,j)      + ocean_sfc_z0h_t(i,j)      * dt
       ocean_sfc_z0e(i,j)      = ocean_sfc_z0e(i,j)      + ocean_sfc_z0e_t(i,j)      * dt
    enddo
    enddo

    call ocean_vars_total

    !########## Set Surface Boundary to coupler ##########
    call prof_rapstart('OCN_SfcExch', 2)
    call ocean_surface_set( countup=.true. )
    call prof_rapend  ('OCN_SfcExch', 2)

    !########## reset tendencies ##########
!OCL XFILL
    do j = js, je
    do i = is, ie
       ocean_temp_t(i,j)      = 0.0_rp
       ocean_sfc_temp_t(i,j)      = 0.0_rp
       ocean_sfc_albedo_t(i,j,i_lw) = 0.0_rp
       ocean_sfc_albedo_t(i,j,i_sw) = 0.0_rp
       ocean_sfc_z0m_t(i,j)      = 0.0_rp
       ocean_sfc_z0h_t(i,j)      = 0.0_rp
       ocean_sfc_z0e_t(i,j)      = 0.0_rp
    enddo
    enddo

    !########## History & Monitor ##########
    call prof_rapstart('OCN_History', 1)
    call ocean_vars_history
    call prof_rapend  ('OCN_History', 1)

    return
  end subroutine ocean_driver

  !-----------------------------------------------------------------------------
  subroutine ocean_surface_get
    use mod_ocean_admin, only: &
       ocean_sw
    use mod_ocean_vars, only: &
       atmos_temp,     &
       atmos_pres,     &
       atmos_w,        &
       atmos_u,        &
       atmos_v,        &
       atmos_dens,     &
       atmos_qv,       &
       atmos_pbl,      &
       atmos_sfc_pres, &
       atmos_sflx_lw,  &
       atmos_sflx_sw,  &
       atmos_cossza,   &
       atmos_sflx_prec
    use mod_cpl_vars, only: &
       cpl_getatm_ocn
    implicit none

    real(RP) :: atmos_sflx_rad_dn(ia,ja,2,2)
    real(RP) :: atmos_sflx_rain  (ia,ja)
    real(RP) :: atmos_sflx_snow  (ia,ja)

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

    if ( ocean_sw ) 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_pres(:,:),     & ! [OUT]
                            atmos_sflx_rad_dn(:,:,:,:), & ! [OUT]
                            atmos_cossza(:,:),     & ! [OUT]
                            atmos_sflx_rain(:,:),     & ! [OUT]
                            atmos_sflx_snow(:,:)      ) ! [OUT]
    endif

!OCL XFILL
    do j = js, je
    do i = is, ie
       atmos_sflx_sw(i,j) = atmos_sflx_rad_dn(i,j,i_sw,1) + atmos_sflx_rad_dn(i,j,i_sw,2) ! direct+diffuse
       atmos_sflx_lw(i,j) = atmos_sflx_rad_dn(i,j,i_lw,1) + atmos_sflx_rad_dn(i,j,i_lw,2) ! direct+diffuse

       atmos_sflx_prec(i,j) = atmos_sflx_rain(i,j) + atmos_sflx_snow(i,j) ! liquid+ice
    enddo
    enddo

    return
  end subroutine ocean_surface_get

  !-----------------------------------------------------------------------------
  subroutine ocean_surface_set( countup )
    use mod_ocean_admin, only: &
       ocean_sw
    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_wh,       &
       ocean_sflx_evap,     &
       ocean_u10,           &
       ocean_v10,           &
       ocean_t2,            &
       ocean_q2
    use mod_cpl_vars, only: &
       cpl_putocn
    implicit none

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

    if ( ocean_sw ) 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_wh(:,:),   & ! [IN]
                        ocean_sflx_evap(:,:),   & ! [IN]
                        ocean_u10(:,:),   & ! [IN]
                        ocean_v10(:,:),   & ! [IN]
                        ocean_t2(:,:),   & ! [IN]
                        ocean_q2(:,:),   & ! [IN]
                        countup                  ) ! [IN]
    endif

    return
  end subroutine ocean_surface_set

end module mod_ocean_driver