scale_atmos_phy_cp_common.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scalelib.h"
module scale_atmos_phy_cp_common
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
  use scale_prof
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: atmos_phy_cp_common_setup
  public :: atmos_phy_cp_common_wmean
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
  ! tuning parameter
  logical,  private :: PARAM_ATMOS_PHY_CP_wadapt = .true.
  integer,  private :: PARAM_ATMOS_PHY_CP_w_time = 16
  !------------------------------------------------------------------------------
contains
  !------------------------------------------------------------------------------
  subroutine atmos_phy_cp_common_setup
    use scale_prc, only: &
       prc_abort
    implicit none
 
    namelist / param_atmos_phy_cp_common / &
       param_atmos_phy_cp_wadapt, &
       param_atmos_phy_cp_w_time
 
    integer :: ierr
    !---------------------------------------------------------------------------
 
    log_newline
    log_info("ATMOS_PHY_CP_common_setup",*) 'Setup'
    log_info("ATMOS_PHY_CP_common_setup",*) 'CP-COMMON'
 
    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_atmos_phy_cp_common,iostat=ierr)
    if( ierr < 0 ) then !--- missing
       log_info("ATMOS_PHY_CP_common_setup",*) 'Not found namelist. Default used.'
    elseif( ierr > 0 ) then !--- fatal error
       log_error("ATMOS_PHY_CP_common_setup",*) 'Not appropriate names in namelist PARAM_ATMOS_PHY_CP_COMMON. Check!'
       call prc_abort
    endif
    log_nml(param_atmos_phy_cp_common)
 
    ! output parameter lists
    log_newline
    log_info("ATMOS_PHY_CP_common_setup",*) "Use running mean of w in adaptive timestep?     : ", param_atmos_phy_cp_wadapt
    log_info("ATMOS_PHY_CP_common_setup",*) "Fixed time scale for running mean of w          : ", param_atmos_phy_cp_w_time
 
    return
  end subroutine atmos_phy_cp_common_setup
 
  !-----------------------------------------------------------------------------
  !-----------------------------------------------------------------------------
  subroutine atmos_phy_cp_common_wmean( &
       KA, KS, KE, IA, IS, IE, JA, JS, JE, &
       W,                    &
       TIME_DTSEC, CP_DTSEC, &
       W0_mean               )
    implicit none
    integer,  intent(in)    :: ka, ks, ke
    integer,  intent(in)    :: ia, is, ie
    integer,  intent(in)    :: ja, js, je
 
    real(rp), intent(in)    :: w(ka,ia,ja)
    real(dp), intent(in)    :: time_dtsec
    real(dp), intent(in)    :: cp_dtsec
 
    real(rp), intent(inout) :: w0_mean(ka,ia,ja)
 
    real(rp) :: fact_w0_mean, fact_w0
 
    integer :: k, i, j
    !---------------------------------------------------------------------------
 
    if ( param_atmos_phy_cp_wadapt ) then
       fact_w0_mean = 2.0_rp * max(cp_dtsec,time_dtsec) - time_dtsec
       fact_w0      = time_dtsec
    else ! w_time is tuning parameter
       fact_w0_mean = real(param_atmos_phy_cp_w_time,rp)
       fact_w0      = 1.0_rp
    endif
 
    !$acc kernels
    do j = js, je
    do i = is, ie
    do k = ks, ke
       w0_mean(k,i,j) = ( w0_mean(k,i,j) * fact_w0_mean &
                        + w(k,i,j)       * fact_w0      ) / ( fact_w0_mean + fact_w0 )
    enddo
    enddo
    enddo
    !$acc end kernels
 
    return
  end subroutine atmos_phy_cp_common_wmean
 
end module scale_atmos_phy_cp_common