scale_ocean_phy_albedo.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scalelib.h"
module scale_ocean_phy_albedo
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
  use scale_prof
  use scale_cpl_sfc_index
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: ocean_phy_albedo_const_setup
  public :: ocean_phy_albedo_seaice_setup
  public :: ocean_phy_albedo_const
  public :: ocean_phy_albedo_seaice
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  real(RP), private :: OCEAN_PHY_ALBEDO_IR_dir         = 0.05_rp
  real(RP), private :: OCEAN_PHY_ALBEDO_IR_dif         = 0.05_rp
  real(RP), private :: OCEAN_PHY_ALBEDO_NIR_dir        = 0.07_rp
  real(RP), private :: OCEAN_PHY_ALBEDO_NIR_dif        = 0.06_rp
  real(RP), private :: OCEAN_PHY_ALBEDO_VIS_dir        = 0.07_rp
  real(RP), private :: OCEAN_PHY_ALBEDO_VIS_dif        = 0.06_rp
 
  real(RP), private :: OCEAN_PHY_ALBEDO_seaice_IR_dir  = 0.05_rp
  real(RP), private :: OCEAN_PHY_ALBEDO_seaice_IR_dif  = 0.05_rp
  real(RP), private :: OCEAN_PHY_ALBEDO_seaice_NIR_dir = 0.60_rp
  real(RP), private :: OCEAN_PHY_ALBEDO_seaice_NIR_dif = 0.60_rp
  real(RP), private :: OCEAN_PHY_ALBEDO_seaice_VIS_dir = 0.80_rp
  real(RP), private :: OCEAN_PHY_ALBEDO_seaice_VIS_dif = 0.80_rp
 
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine ocean_phy_albedo_const_setup
    use scale_prc, only: &
       prc_abort
    implicit none
 
    namelist / param_ocean_phy_albedo_const / &
       ocean_phy_albedo_ir_dir,  &
       ocean_phy_albedo_ir_dif,  &
       ocean_phy_albedo_nir_dir, &
       ocean_phy_albedo_nir_dif, &
       ocean_phy_albedo_vis_dir, &
       ocean_phy_albedo_vis_dif
 
    integer :: ierr
    !---------------------------------------------------------------------------
 
    log_newline
    log_info("OCEAN_PHY_ALBEDO_const_setup",*) 'Setup'
 
    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_ocean_phy_albedo_const,iostat=ierr)
    if( ierr < 0 ) then !--- missing
       log_info("OCEAN_PHY_ALBEDO_const_setup",*) 'Not found namelist. Default used.'
    elseif( ierr > 0 ) then !--- fatal error
       log_error("OCEAN_PHY_ALBEDO_const_setup",*) 'Not appropriate names in namelist PARAM_OCEAN_PHY_ALBEDO_const. Check!'
       call prc_abort
    endif
    log_nml(param_ocean_phy_albedo_const)
 
    return
  end subroutine ocean_phy_albedo_const_setup
 
  !-----------------------------------------------------------------------------
  subroutine ocean_phy_albedo_seaice_setup
    use scale_prc, only: &
       prc_abort
    implicit none
 
    namelist / param_ocean_phy_albedo_seaice / &
       ocean_phy_albedo_seaice_ir_dir,  &
       ocean_phy_albedo_seaice_ir_dif,  &
       ocean_phy_albedo_seaice_nir_dir, &
       ocean_phy_albedo_seaice_nir_dif, &
       ocean_phy_albedo_seaice_vis_dir, &
       ocean_phy_albedo_seaice_vis_dif
 
    integer :: ierr
    !---------------------------------------------------------------------------
 
    log_newline
    log_info("OCEAN_PHY_ALBEDO_seaice_setup",*) 'Setup'
 
    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_ocean_phy_albedo_seaice,iostat=ierr)
    if( ierr < 0 ) then !--- missing
       log_info("OCEAN_PHY_ALBEDO_seaice_setup",*) 'Not found namelist. Default used.'
    elseif( ierr > 0 ) then !--- fatal error
       log_error("OCEAN_PHY_ALBEDO_seaice_setup",*) 'Not appropriate names in namelist PARAM_OCEAN_PHY_ALBEDO_seaice. Check!'
       call prc_abort
    endif
    log_nml(param_ocean_phy_albedo_seaice)
 
    return
  end subroutine ocean_phy_albedo_seaice_setup
 
  !-----------------------------------------------------------------------------
  subroutine ocean_phy_albedo_const( &
       OIA, OIS, OIE, &
       OJA, OJS, OJE, &
       SFC_albedo     )
    implicit none
 
    integer,  intent(in)  :: oia, ois, oie
    integer,  intent(in)  :: oja, ojs, oje
    real(rp), intent(out) :: sfc_albedo(oia,oja,n_rad_dir,n_rad_rgn) ! surface albedo (0-1)
 
    integer :: i, j
    !---------------------------------------------------------------------------
    !$acc data copyout(SFC_albedo)
 
    !$acc kernels
    do j = ojs, oje
    do i = ois, oie
       sfc_albedo(i,j,i_r_direct ,i_r_ir ) = ocean_phy_albedo_ir_dir
       sfc_albedo(i,j,i_r_diffuse,i_r_ir ) = ocean_phy_albedo_ir_dif
       sfc_albedo(i,j,i_r_direct ,i_r_nir) = ocean_phy_albedo_nir_dir
       sfc_albedo(i,j,i_r_diffuse,i_r_nir) = ocean_phy_albedo_nir_dif
       sfc_albedo(i,j,i_r_direct ,i_r_vis) = ocean_phy_albedo_vis_dir
       sfc_albedo(i,j,i_r_diffuse,i_r_vis) = ocean_phy_albedo_vis_dif
    enddo
    enddo
    !$acc end kernels
 
    !$acc end data
    return
  end subroutine ocean_phy_albedo_const
 
  !-----------------------------------------------------------------------------
  subroutine ocean_phy_albedo_seaice( &
       OIA, OIS, OIE, &
       OJA, OJS, OJE, &
       SFC_albedo     )
    implicit none
 
    integer,  intent(in)  :: oia, ois, oie
    integer,  intent(in)  :: oja, ojs, oje
    real(rp), intent(out) :: sfc_albedo(oia,oja,n_rad_dir,n_rad_rgn) ! surface albedo (0-1)
 
    integer :: i, j
    !---------------------------------------------------------------------------
    !$acc data copyout(SFC_albedo)
 
    !$acc kernels
    do j = ojs, oje
    do i = ois, oie
       sfc_albedo(i,j,i_r_direct ,i_r_ir ) = ocean_phy_albedo_seaice_ir_dir
       sfc_albedo(i,j,i_r_diffuse,i_r_ir ) = ocean_phy_albedo_seaice_ir_dif
       sfc_albedo(i,j,i_r_direct ,i_r_nir) = ocean_phy_albedo_seaice_nir_dir
       sfc_albedo(i,j,i_r_diffuse,i_r_nir) = ocean_phy_albedo_seaice_nir_dif
       sfc_albedo(i,j,i_r_direct ,i_r_vis) = ocean_phy_albedo_seaice_vis_dir
       sfc_albedo(i,j,i_r_diffuse,i_r_vis) = ocean_phy_albedo_seaice_vis_dif
    enddo
    enddo
    !$acc end kernels
 
    !$acc end data
 
    return
  end subroutine ocean_phy_albedo_seaice
 
end module scale_ocean_phy_albedo