scale_atmos_phy_rd_offline.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scalelib.h"
module scale_atmos_phy_rd_offline
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
  use scale_prof
  use scale_cpl_sfc_index
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: atmos_phy_rd_offline_setup
  public :: atmos_phy_rd_offline_flux
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
  integer,  private, parameter :: num_vars_3d    = 4
  integer,  private, parameter :: num_vars_2d    = 4
  integer,  private, parameter :: num_vars_2d_op = 4 ! optional
 
  real(RP), private :: ATMOS_PHY_RD_offline_diffuse_rate = 0.5_rp
  real(RP), private :: ATMOS_PHY_RD_offline_NIR_rate     = 0.5_rp
 
  logical, private :: vars_2d_exist(num_vars_2d_op)
 
contains
  !-----------------------------------------------------------------------------
  subroutine atmos_phy_rd_offline_setup
    use scale_prc, only: &
       prc_abort
    use scale_file_external_input, only: &
       file_external_input_regist
    use scale_const, only: &
       undef => const_undef
    implicit none
 
    character(len=H_SHORT) :: vars_3d   (num_vars_3d)
    character(len=H_SHORT) :: vars_2d   (num_vars_2d)
    character(len=H_SHORT) :: vars_2d_op(num_vars_2d_op)
 
    data vars_3d    / 'RFLX_LW_up', 'RFLX_LW_dn', 'RFLX_SW_up', 'RFLX_SW_dn' /
    data vars_2d    / 'SFLX_LW_up', 'SFLX_LW_dn', 'SFLX_SW_up', 'SFLX_SW_dn' /
    data vars_2d_op / 'SFLX_NIR_dn_dir', 'SFLX_NIR_dn_dif', 'SFLX_VIS_dn_dir', 'SFLX_VIS_dn_dif' /
 
    character(len=H_LONG)  :: atmos_phy_rd_offline_basename              = ''
    logical                :: atmos_phy_rd_offline_basename_add_num      = .false.
    integer                :: atmos_phy_rd_offline_number_of_files       = 1
    character(len=H_SHORT) :: atmos_phy_rd_offline_axistype              = 'XYZ'
    logical                :: atmos_phy_rd_offline_enable_periodic_year  = .false.
    logical                :: atmos_phy_rd_offline_enable_periodic_month = .false.
    logical                :: atmos_phy_rd_offline_enable_periodic_day   = .false.
    integer                :: atmos_phy_rd_offline_step_fixed            = 0
    real(rp)               :: atmos_phy_rd_offline_offset                = 0.0_rp
    real(rp)               :: atmos_phy_rd_offline_defval               ! = UNDEF
    logical                :: atmos_phy_rd_offline_check_coordinates     = .true.
    integer                :: atmos_phy_rd_offline_step_limit            = 0
 
    namelist / param_atmos_phy_rd_offline / &
       atmos_phy_rd_offline_basename,              &
       atmos_phy_rd_offline_basename_add_num,      &
       atmos_phy_rd_offline_number_of_files,       &
       atmos_phy_rd_offline_axistype,              &
       atmos_phy_rd_offline_enable_periodic_year,  &
       atmos_phy_rd_offline_enable_periodic_month, &
       atmos_phy_rd_offline_enable_periodic_day,   &
       atmos_phy_rd_offline_step_fixed,            &
       atmos_phy_rd_offline_offset,                &
       atmos_phy_rd_offline_defval,                &
       atmos_phy_rd_offline_check_coordinates,     &
       atmos_phy_rd_offline_step_limit,            &
       atmos_phy_rd_offline_diffuse_rate,          &
       atmos_phy_rd_offline_nir_rate
 
    integer :: n, ierr
    !---------------------------------------------------------------------------
 
    log_newline
    log_info("ATMOS_PHY_RD_offline_setup",*) 'Setup'
    log_info("ATMOS_PHY_RD_offline_setup",*) 'Offline radiation process'
 
    atmos_phy_rd_offline_defval = undef
 
    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_atmos_phy_rd_offline,iostat=ierr)
    if( ierr < 0 ) then !--- missing
       log_info("ATMOS_PHY_RD_offline_setup",*) 'Not found namelist. Default used.'
    elseif( ierr > 0 ) then !--- fatal error
       log_error("ATMOS_PHY_RD_offline_setup",*) 'Not appropriate names in namelist PARAM_ATMOS_PHY_RD_OFFLINE. Check!'
       call prc_abort
    endif
    log_nml(param_atmos_phy_rd_offline)
 
    if ( atmos_phy_rd_offline_basename == '' ) then
       log_error("ATMOS_PHY_RD_offline_setup",*) 'ATMOS_PHY_RD_offline_basename is necessary'
       call prc_abort
    end if
 
    do n = 1, num_vars_3d
       call file_external_input_regist( atmos_phy_rd_offline_basename,              & ! [IN]
                                        atmos_phy_rd_offline_basename_add_num,      & ! [IN]
                                        atmos_phy_rd_offline_number_of_files,       & ! [IN]
                                        vars_3d(n),                                 & ! [IN]
                                        atmos_phy_rd_offline_axistype,              & ! [IN]
                                        atmos_phy_rd_offline_enable_periodic_year,  & ! [IN]
                                        atmos_phy_rd_offline_enable_periodic_month, & ! [IN]
                                        atmos_phy_rd_offline_enable_periodic_day,   & ! [IN]
                                        atmos_phy_rd_offline_step_fixed,            & ! [IN]
                                        atmos_phy_rd_offline_offset,                & ! [IN]
                                        atmos_phy_rd_offline_defval,                & ! [IN]
                                        check_coordinates = atmos_phy_rd_offline_check_coordinates, & ! [IN]
                                        step_limit        = atmos_phy_rd_offline_step_limit         ) ! [IN]
    end do
 
    do n = 1, num_vars_2d
       call file_external_input_regist( atmos_phy_rd_offline_basename,              & ! [IN]
                                        atmos_phy_rd_offline_basename_add_num,      & ! [IN]
                                        atmos_phy_rd_offline_number_of_files,       & ! [IN]
                                        vars_2d(n),                                 & ! [IN]
                                        'XY',                                       & ! [IN]
                                        atmos_phy_rd_offline_enable_periodic_year,  & ! [IN]
                                        atmos_phy_rd_offline_enable_periodic_month, & ! [IN]
                                        atmos_phy_rd_offline_enable_periodic_day,   & ! [IN]
                                        atmos_phy_rd_offline_step_fixed,            & ! [IN]
                                        atmos_phy_rd_offline_offset,                & ! [IN]
                                        atmos_phy_rd_offline_defval,                & ! [IN]
                                        check_coordinates = atmos_phy_rd_offline_check_coordinates, & ! [IN]
                                        step_limit        = atmos_phy_rd_offline_step_limit         ) ! [IN]
    end do
 
    do n = 1, num_vars_2d_op
       call file_external_input_regist( atmos_phy_rd_offline_basename,              & ! [IN]
                                        atmos_phy_rd_offline_basename_add_num,      & ! [IN]
                                        atmos_phy_rd_offline_number_of_files,       & ! [IN]
                                        vars_2d_op(n),                              & ! [IN]
                                        'XY',                                       & ! [IN]
                                        atmos_phy_rd_offline_enable_periodic_year,  & ! [IN]
                                        atmos_phy_rd_offline_enable_periodic_month, & ! [IN]
                                        atmos_phy_rd_offline_enable_periodic_day,   & ! [IN]
                                        atmos_phy_rd_offline_step_fixed,            & ! [IN]
                                        atmos_phy_rd_offline_offset,                & ! [IN]
                                        atmos_phy_rd_offline_defval,                & ! [IN]
                                        check_coordinates = atmos_phy_rd_offline_check_coordinates, & ! [IN]
                                        step_limit        = atmos_phy_rd_offline_step_limit,        & ! [IN]
                                        exist             = vars_2d_exist(n)                        ) ! [OUT]
       if ( vars_2d_exist(n) ) then
          log_info("ATMOS_PHY_RD_offline_setup",*) '', trim(vars_2d_op(n)), ' found.'
       else
          log_info("ATMOS_PHY_RD_offline_setup",*) '', trim(vars_2d_op(n)), ' not found.'
       end if
    end do
 
    return
  end subroutine atmos_phy_rd_offline_setup
 
  !-----------------------------------------------------------------------------
  subroutine atmos_phy_rd_offline_flux( &
       KA, KS, KE, IA, IS, IE, JA, JS, JE, &
       time_now,   &
       flux_rad,   &
       SFLX_rad_dn )
    use scale_prc, only: &
       prc_abort
    use scale_file_external_input, only: &
       file_external_input_update
    use scale_atmos_phy_rd_common, only: &
       i_sw, &
       i_lw, &
       i_dn, &
       i_up
    implicit none
 
    integer,  intent(in)  :: ka, ks, ke
    integer,  intent(in)  :: ia, is, ie
    integer,  intent(in)  :: ja, js, je
    real(dp), intent(in)  :: time_now
    real(rp), intent(out) :: flux_rad   (ka,ia,ja,2,2)
    real(rp), intent(out) :: sflx_rad_dn(ia,ja,n_rad_dir,n_rad_rgn)
 
    real(rp) :: buffer(ia,ja)
    logical  :: error, error_sum, error_sflx
 
    integer  :: i, j
    !---------------------------------------------------------------------------
 
    log_progress(*) 'atmosphere / physics / radiation / offline'
 
    ! [note] external data input is now support only SCALE-RM
 
    error_sum = .false.
 
    ! 3D
    call file_external_input_update( 'RFLX_LW_up', time_now, flux_rad(:,:,:,i_lw,i_up), error )
    error_sum = ( error .OR. error_sum )
 
    call file_external_input_update( 'RFLX_LW_dn', time_now, flux_rad(:,:,:,i_lw,i_dn), error )
    error_sum = ( error .OR. error_sum )
 
    call file_external_input_update( 'RFLX_SW_up', time_now, flux_rad(:,:,:,i_sw,i_up), error )
    error_sum = ( error .OR. error_sum )
 
    call file_external_input_update( 'RFLX_SW_dn', time_now, flux_rad(:,:,:,i_sw,i_dn), error )
    error_sum = ( error .OR. error_sum )
 
 
    ! 2D
    call file_external_input_update( 'SFLX_LW_up', time_now, buffer(:,:), error )
    if ( error ) then
       error_sum = .true.
    else
       !$omp parallel do default(none) OMP_SCHEDULE_ &
       !$omp private(i,j) &
       !$omp shared(KS,IS,IE,JS,JE) &
       !$omp shared(flux_rad,buffer)
       do j = js, je
       do i = is, ie
          flux_rad(ks-1,i,j,i_lw,i_up) = buffer(i,j)
       end do
       end do
    end if
 
    call file_external_input_update( 'SFLX_LW_dn', time_now, buffer(:,:), error )
    if ( error ) then
       error_sum = .true.
    else
       !$omp parallel do default(none) OMP_SCHEDULE_ &
       !$omp private(i,j) &
       !$omp shared(KS,IS,IE,JS,JE) &
       !$omp shared(flux_rad,buffer)
       do j = js, je
       do i = is, ie
          flux_rad(ks-1,i,j,i_lw,i_dn) = buffer(i,j)
       end do
       end do
    end if
 
    call file_external_input_update( 'SFLX_SW_up', time_now, buffer(:,:), error )
    if ( error ) then
       error_sum = .true.
    else
       !$omp parallel do default(none) OMP_SCHEDULE_ &
       !$omp private(i,j) &
       !$omp shared(KS,IS,IE,JS,JE) &
       !$omp shared(flux_rad,buffer)
       do j = js, je
       do i = is, ie
          flux_rad(ks-1,i,j,i_sw,i_up) = buffer(i,j)
       end do
       end do
    end if
 
    call file_external_input_update( 'SFLX_SW_dn', time_now, buffer(:,:), error )
    if ( error ) then
       error_sum = .true.
    else
       !$omp parallel do default(none) OMP_SCHEDULE_ &
       !$omp private(i,j) &
       !$omp shared(KS,IS,IE,JS,JE) &
       !$omp shared(flux_rad,buffer)
       do j = js, je
       do i = is, ie
          flux_rad(ks-1,i,j,i_sw,i_dn) = buffer(i,j)
       end do
       end do
    end if
 
    !$omp parallel do default(none) OMP_SCHEDULE_ &
    !$omp private(i,j) &
    !$omp shared(KS,IS,IE,JS,JE,ATMOS_PHY_RD_offline_diffuse_rate) &
    !$omp shared(SFLX_rad_dn,flux_rad)
    do j = js, je
    do i = is, ie
       sflx_rad_dn(i,j,i_r_direct ,i_r_ir) = 0.0_rp
       sflx_rad_dn(i,j,i_r_diffuse,i_r_ir) = flux_rad(ks-1,i,j,i_lw,i_dn)
    end do
    end do
 
    ! 2D optional
 
    error_sflx = .false.
 
    if ( vars_2d_exist(1) ) then
       call file_external_input_update( 'SFLX_NIR_dn_dir', time_now, sflx_rad_dn(:,:,i_r_direct,i_r_vis), error )
       error_sum = ( error .OR. error_sum )
    else
       error_sflx = .true.
    endif
 
    if ( vars_2d_exist(2) ) then
       call file_external_input_update( 'SFLX_NIR_dn_dif', time_now, sflx_rad_dn(:,:,i_r_direct,i_r_vis), error )
       error_sum = ( error .OR. error_sum )
    else
       error_sflx = .true.
    endif
 
    if ( vars_2d_exist(3) ) then
       call file_external_input_update( 'SFLX_VIS_dn_dir', time_now, sflx_rad_dn(:,:,i_r_direct,i_r_vis), error )
       error_sum = ( error .OR. error_sum )
    else
       error_sflx = .true.
    endif
 
    if ( vars_2d_exist(4) ) then
       call file_external_input_update( 'SFLX_VIS_dn_dif', time_now, sflx_rad_dn(:,:,i_r_direct,i_r_vis), error )
       error_sum = ( error .OR. error_sum )
    else
       error_sflx = .true.
    endif
 
    if ( error_sflx ) then ! reconstruct from lowermost SW flux
       !$omp parallel do default(none) OMP_SCHEDULE_ &
       !$omp private(i,j) &
       !$omp shared(KS,IS,IE,JS,JE,ATMOS_PHY_RD_offline_diffuse_rate,ATMOS_PHY_RD_offline_NIR_rate) &
       !$omp shared(SFLX_rad_dn,flux_rad)
       do j = js, je
       do i = is, ie
          sflx_rad_dn(i,j,i_r_direct ,i_r_nir) = ( 1.0_rp-atmos_phy_rd_offline_diffuse_rate ) &
                                               * (        atmos_phy_rd_offline_nir_rate     ) * flux_rad(ks-1,i,j,i_sw,i_dn)
          sflx_rad_dn(i,j,i_r_diffuse,i_r_nir) = (        atmos_phy_rd_offline_diffuse_rate ) &
                                               * (        atmos_phy_rd_offline_nir_rate     ) * flux_rad(ks-1,i,j,i_sw,i_dn)
          sflx_rad_dn(i,j,i_r_direct ,i_r_vis) = ( 1.0_rp-atmos_phy_rd_offline_diffuse_rate ) &
                                               * ( 1.0_rp-atmos_phy_rd_offline_nir_rate     ) * flux_rad(ks-1,i,j,i_sw,i_dn)
          sflx_rad_dn(i,j,i_r_diffuse,i_r_vis) = (        atmos_phy_rd_offline_diffuse_rate ) &
                                               * ( 1.0_rp-atmos_phy_rd_offline_nir_rate     ) * flux_rad(ks-1,i,j,i_sw,i_dn)
       enddo
       enddo
    endif
 
    if ( error_sum ) then
       log_error("ATMOS_PHY_RD_offline_flux",*) 'Requested data is not found!'
       call prc_abort
    endif
 
    return
  end subroutine atmos_phy_rd_offline_flux
 
end module scale_atmos_phy_rd_offline