scale_ocean_dyn_slab.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scalelib.h"
module scale_ocean_dyn_slab
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
  use scale_prof
  use scale_debug
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: ocean_dyn_slab_setup
  public :: ocean_dyn_slab
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  real(RP), private :: OCEAN_DYN_SLAB_HeatCapacity
 
  logical,  private :: OCEAN_DYN_SLAB_nudging        = .false. 
  real(DP), private :: OCEAN_DYN_SLAB_nudging_tausec
  logical,  private :: OCEAN_DYN_SLAB_offline_mode   = .false. 
 
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine ocean_dyn_slab_setup( DEPTH )
    use scale_prc, only: &
       prc_abort
    use scale_const, only: &
       undef => const_undef, &
       dwatr => const_dwatr
    use scale_atmos_hydrometeor, only: &
       cv_water
    use scale_calendar, only: &
       calendar_unit2sec
    use scale_file_external_input, only: &
       file_external_input_regist
    implicit none
    real(rp), intent(in) :: depth
 
    real(dp)               :: ocean_dyn_slab_nudging_tau                   = 0.0_dp  ! Relaxation time
    character(len=H_SHORT) :: ocean_dyn_slab_nudging_tau_unit              = "SEC"
    character(len=H_LONG)  :: ocean_dyn_slab_nudging_basename              = ''
    logical                :: ocean_dyn_slab_nudging_basename_add_num      = .false.
    integer                :: ocean_dyn_slab_nudging_number_of_files       = 1
    logical                :: ocean_dyn_slab_nudging_enable_periodic_year  = .false.
    logical                :: ocean_dyn_slab_nudging_enable_periodic_month = .false.
    logical                :: ocean_dyn_slab_nudging_enable_periodic_day   = .false.
    integer                :: ocean_dyn_slab_nudging_step_fixed            = 0
    real(rp)               :: ocean_dyn_slab_nudging_defval                ! = UNDEF
    logical                :: ocean_dyn_slab_nudging_check_coordinates     = .true.
    integer                :: ocean_dyn_slab_nudging_step_limit            = 0
 
    ! obsolete
    real(rp)               :: ocean_dyn_slab_depth = -1.0_rp
 
    namelist / param_ocean_dyn_slab / &
       ocean_dyn_slab_nudging,                       &
       ocean_dyn_slab_nudging_tau,                   &
       ocean_dyn_slab_nudging_tau_unit,              &
       ocean_dyn_slab_nudging_basename,              &
       ocean_dyn_slab_nudging_basename_add_num,      &
       ocean_dyn_slab_nudging_number_of_files,       &
       ocean_dyn_slab_nudging_enable_periodic_year,  &
       ocean_dyn_slab_nudging_enable_periodic_month, &
       ocean_dyn_slab_nudging_enable_periodic_day,   &
       ocean_dyn_slab_nudging_step_fixed,            &
       ocean_dyn_slab_nudging_defval,                &
       ocean_dyn_slab_nudging_check_coordinates,     &
       ocean_dyn_slab_nudging_step_limit,            &
       ocean_dyn_slab_depth
 
    integer :: ierr
    !---------------------------------------------------------------------------
 
    log_newline
    log_info("OCEAN_DYN_SLAB_setup",*) 'Setup'
 
    ocean_dyn_slab_nudging_defval = undef
 
    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_ocean_dyn_slab,iostat=ierr)
    if( ierr < 0 ) then !--- missing
       log_info("OCEAN_DYN_SLAB_setup",*) 'Not found namelist. Default used.'
    elseif( ierr > 0 ) then !--- fatal error
       log_error("OCEAN_DYN_SLAB_setup",*) 'Not appropriate names in namelist PARAM_OCEAN_DYN_SLAB. Check!'
       call prc_abort
    endif
    log_nml(param_ocean_dyn_slab)
 
    if ( ocean_dyn_slab_depth >= 0.0 ) then
       log_error("OCEAN_DYN_SLAB_setup",*) '"OCEAN_DYN_SLAB_DEPTH" is obsolete. USE "ODZ" of "PARAM_OCEAN_GRID_CARTESC"'
       call prc_abort
    end if
 
    ocean_dyn_slab_heatcapacity = dwatr * cv_water * depth
 
    log_newline
    log_info("OCEAN_DYN_SLAB_setup",*) 'Slab ocean depth [m]         : ', depth
    log_info("OCEAN_DYN_SLAB_setup",*) 'Ocean heat capacity [J/K/m2] : ', ocean_dyn_slab_heatcapacity
 
    if ( ocean_dyn_slab_nudging ) then
       call calendar_unit2sec( ocean_dyn_slab_nudging_tausec, ocean_dyn_slab_nudging_tau, ocean_dyn_slab_nudging_tau_unit )
 
       log_info("OCEAN_DYN_SLAB_setup",*) 'Use nudging for SST : ON'
       log_info("OCEAN_DYN_SLAB_setup",*) 'Relaxation time Tau [sec] : ', ocean_dyn_slab_nudging_tausec
 
       if ( ocean_dyn_slab_nudging_tausec == 0.0_rp ) then
          ocean_dyn_slab_offline_mode = .true.
          log_info("OCEAN_DYN_SLAB_setup",*) 'Tau=0 means that SST is completely replaced by the external data.'
       endif
 
       if ( ocean_dyn_slab_nudging_basename == '' ) then
          log_error("OCEAN_DYN_SLAB_setup",*) 'OCEAN_DYN_SLAB_nudging_basename is necessary !!'
          call prc_abort
       endif
    else
       log_info("OCEAN_DYN_SLAB_setup",*) 'Use nudging for SST : OFF'
    endif
 
    if ( ocean_dyn_slab_nudging ) then
       call file_external_input_regist( ocean_dyn_slab_nudging_basename,              & ! [IN]
                                        ocean_dyn_slab_nudging_basename_add_num,      & ! [IN]
                                        ocean_dyn_slab_nudging_number_of_files,       & ! [IN]
                                        'OCEAN_TEMP',                                 & ! [IN]
                                        'OXY',                                        & ! [IN]
                                        ocean_dyn_slab_nudging_enable_periodic_year,  & ! [IN]
                                        ocean_dyn_slab_nudging_enable_periodic_month, & ! [IN]
                                        ocean_dyn_slab_nudging_enable_periodic_day,   & ! [IN]
                                        ocean_dyn_slab_nudging_step_fixed,            & ! [IN]
                                        ocean_dyn_slab_nudging_defval,                & ! [IN]
                                        check_coordinates = ocean_dyn_slab_nudging_check_coordinates, & ! [IN]
                                        step_limit        = ocean_dyn_slab_nudging_step_limit,        & ! [IN]
                                        allow_missing     = ( .not. ocean_dyn_slab_offline_mode )     ) ! [IN]
    endif
 
    return
  end subroutine ocean_dyn_slab_setup
 
  !-----------------------------------------------------------------------------
  subroutine ocean_dyn_slab( &
       OKMAX, OKS, OKE,  &
       OIA,   OIS, OIE,  &
       OJA,   OJS, OJE,  &
       OCEAN_TEMP_t,     &
       OCEAN_SFLX_G,     &
       OCEAN_SFLX_water, &
       calc_flag,        &
       dt, NOWDAYSEC,    &
       OCEAN_TEMP,       &
       MASS_SUPL,        &
       ENGI_SUPL         )
    use scale_prc, only: &
       prc_abort
    use scale_const, only: &
       undef => const_undef
    use scale_file_external_input, only: &
       file_external_input_update
    use scale_atmos_hydrometeor, only: &
       cv_water
    implicit none
 
    integer,  intent(in)    :: okmax, oks, oke
    integer,  intent(in)    :: oia,   ois, oie
    integer,  intent(in)    :: oja,   ojs, oje
    real(rp), intent(in)    :: ocean_temp_t    (okmax,oia,oja) ! tendency of ocean temperature
    real(rp), intent(in)    :: ocean_sflx_g    (oia,oja)       ! heat flux from surface to subsurface (open ocean/sea ice)
    real(rp), intent(in)    :: ocean_sflx_water(oia,oja)       ! mass flux from surface to subsurface (open ocean/sea ice)
    logical,  intent(in)    :: calc_flag       (oia,oja)       ! to decide calculate or not
    real(dp), intent(in)    :: dt
    real(dp), intent(in)    :: nowdaysec
    real(rp), intent(inout) :: ocean_temp      (okmax,oia,oja)
    real(rp), intent(out)   :: mass_supl       (oia,oja)
    real(rp), intent(out)   :: engi_supl       (oia,oja)
 
    real(rp) :: ocean_temp_t_ndg(okmax,oia,oja)
    real(rp) :: ocean_temp_ref  (okmax,oia,oja)
    real(rp) :: rtau
    real(rp) :: dcp
 
    logical  :: error
    integer  :: k, i, j
    !---------------------------------------------------------------------------
    !$acc data copyin (OCEAN_TEMP_t,OCEAN_SFLX_G,OCEAN_SFLX_water,calc_flag) &
    !$acc      copyout(MASS_SUPL,ENGI_SUPL) &
    !$acc      copy(OCEAN_TEMP) &
    !$acc      create (OCEAN_TEMP_t_ndg,OCEAN_TEMP_ref)
 
 
    log_progress(*) 'ocean / dynamics / slab'
 
    if ( ocean_dyn_slab_nudging ) then
 
       call file_external_input_update( 'OCEAN_TEMP', nowdaysec, ocean_temp_ref(:,:,:), error )
 
 
       if ( error ) then
          log_error("OCEAN_DYN_SLAB",*) 'Requested data is not found!'
          call prc_abort
       endif
 
       if ( .not. ocean_dyn_slab_offline_mode ) then
 
          ! if OCEAN_DYN_SLAB_nudging_tau < dt, Nudging acts as quasi-prescribed boundary
          rtau = 1.0_rp / max(ocean_dyn_slab_nudging_tausec,dt)
 
          !$omp parallel do
          !$acc kernels
          do j = ojs, oje
          do i = ois, oie
          do k = oks, oke
             if ( ocean_temp_ref(k,i,j) == undef ) then
                ocean_temp_t_ndg(k,i,j) = 0.0_rp
             else
                ocean_temp_t_ndg(k,i,j) = ( ocean_temp_ref(k,i,j) - ocean_temp(k,i,j) ) * rtau
             end if
          enddo
          enddo
          enddo
          !$acc end kernels
 
       end if
 
    else
       !$omp parallel do
       !$acc kernels
       do j = ojs, oje
       do i = ois, oie
       do k = oks, oke
          ocean_temp_t_ndg(k,i,j) = 0.0_rp
       end do
       end do
       end do
       !$acc end kernels
    endif
 
    if ( ocean_dyn_slab_offline_mode ) then
 
       !$omp parallel do
       !$acc kernels
       do j = ojs, oje
       do i = ois, oie
          if ( calc_flag(i,j) ) then
             ocean_temp(oks,i,j) = ocean_temp_ref(oks,i,j)
          endif
          mass_supl(i,j) = 0.0_rp
          engi_supl(i,j) = 0.0_rp
       enddo
       enddo
       !$acc end kernels
 
    else
 
       !$omp parallel do private(dCP)
       !$acc kernels
       do j = ojs, oje
       do i = ois, oie
          if ( calc_flag(i,j) ) then
             ! heat flux from atm/ice at uppermost ocean layer
             dcp = cv_water * ocean_sflx_water(i,j) * dt
             ocean_temp(oks,i,j) = ocean_temp(oks,i,j) &
                                 + ( ocean_sflx_g(i,j) * dt - dcp * ocean_temp(oks,i,j) ) &
                                   / ( ocean_dyn_slab_heatcapacity + dcp ) &
                                 + ocean_temp_t_ndg(oks,i,j) * dt
             do k = oks+1, oke
                ocean_temp(k,i,j) = ocean_temp(k,i,j) + ocean_temp_t_ndg(k,i,j) * dt
             enddo
             mass_supl(i,j) = - ocean_sflx_water(i,j)
             engi_supl(i,j) = cv_water * mass_supl(i,j) * ocean_temp(oks,i,j)
          else
             mass_supl(i,j) = 0.0_rp
             engi_supl(i,j) = 0.0_rp
          endif
       enddo
       enddo
       !$acc end kernels
 
    endif
    !$acc end data
 
    return
  end subroutine ocean_dyn_slab
 
end module scale_ocean_dyn_slab