scale_ocean_phy_slab.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
module scale_ocean_phy_slab
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_stdio
  use scale_prof
  use scale_debug
  use scale_grid_index
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: ocean_phy_slab_setup
  public :: ocean_phy_slab

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  real(RP), private :: ocean_phy_slab_depth    = 10.0_rp 
  logical,  private :: ocean_phy_slab_fixedsst = .false. 
  real(RP), private :: ocean_phy_slab_heatcapacity

  logical, allocatable, private :: is_ocn(:,:)

  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine ocean_phy_slab_setup( OCEAN_TYPE )
    use scale_process, only: &
       prc_mpistop
    use scale_const, only: &
       dwatr => const_dwatr, &
       cl    => const_cl
    use scale_landuse, only: &
       landuse_fact_ocean
    implicit none

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

    namelist / param_ocean_phy_slab / &
       ocean_phy_slab_depth

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

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

    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_ocean_phy_slab,iostat=ierr)
    if( ierr < 0 ) then !--- missing
       if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
    elseif( ierr > 0 ) then !--- fatal error
       write(*,*) 'xxx Not appropriate names in namelist PARAM_OCEAN_PHY_SLAB. Check!'
       call prc_mpistop
    endif
    if( io_lnml ) write(io_fid_log,nml=param_ocean_phy_slab)

    if( ocean_type == 'CONST' ) then
       ocean_phy_slab_fixedsst = .true.
    else if( ocean_type == 'SLAB' ) then
       ocean_phy_slab_fixedsst = .false.
    else
       write(*,*) 'xxx wrong OCEAN_TYPE. Check!'
       call prc_mpistop
    end if

    ocean_phy_slab_heatcapacity = dwatr * cl * ocean_phy_slab_depth

    if( io_l ) write(io_fid_log,*)
    if( io_l ) write(io_fid_log,*) '*** Prevent SST change?          : ', ocean_phy_slab_fixedsst
    if( io_l ) write(io_fid_log,*) '*** Slab ocean depth [m]         : ', ocean_phy_slab_depth
    if( io_l ) write(io_fid_log,*) '*** Ocean heat capacity [J/K/m2] : ', ocean_phy_slab_heatcapacity

    ! 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
  end subroutine ocean_phy_slab_setup

  !-----------------------------------------------------------------------------
  subroutine ocean_phy_slab( &
       OCEAN_TEMP_t,    &
       OCEAN_TEMP,      &
       OCEAN_SFLX_WH,   &
       OCEAN_SFLX_prec, &
       OCEAN_SFLX_evap, &
       dt               )
    use scale_grid_index
    implicit none

    real(RP), intent(out) :: OCEAN_TEMP_t   (ia,ja)
    real(RP), intent(in)  :: OCEAN_TEMP     (ia,ja)
    real(RP), intent(in)  :: OCEAN_SFLX_WH  (ia,ja)
    real(RP), intent(in)  :: OCEAN_SFLX_prec(ia,ja)
    real(RP), intent(in)  :: OCEAN_SFLX_evap(ia,ja)
    real(DP), intent(in)  :: dt

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

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

    if( ocean_phy_slab_fixedsst )then
       do j = js, je
       do i = is, ie
          ocean_temp_t(i,j) = 0.0_rp
       enddo
       enddo
    else
       do j = js, je
       do i = is, ie
          if( is_ocn(i,j) ) then
             ocean_temp_t(i,j) = - ocean_sflx_wh(i,j) / ocean_phy_slab_heatcapacity
          else
             ocean_temp_t(i,j) = 0.0_rp
          endif
       enddo
       enddo
    end if

    return
  end subroutine ocean_phy_slab

end module scale_ocean_phy_slab