mod_atmos_component.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scaleFElib.h"
module mod_atmos_component
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
  use scale_prof
  use scale_prc
 
  use scale_mesh_base, only: meshbase
  use scale_mesh_base2d, only: meshbase2d
  use scale_mesh_base3d, only: meshbase3d
  use scale_localmesh_2d, only: localmesh2d
  use scale_localmesh_3d, only: localmesh3d
  use scale_localmeshfield_base, only: &
    localmeshfieldbase, localmeshfieldbaselist
  use scale_model_component, only: modelcomponent
  use scale_model_mesh_manager, only: modelmesh3d
 
  use mod_atmos_mesh, only: atmosmesh
  use mod_atmos_mesh_rm, only: atmosmeshrm
  use mod_atmos_mesh_gm, only: atmosmeshgm
 
  use mod_atmos_vars, only: atmosvars
 
  use mod_atmos_dyn, only: atmosdyn
  use mod_atmos_phy_sfc, only: atmosphysfc
  use mod_atmos_phy_tb , only: atmosphytb
  use mod_atmos_phy_mp , only: atmosphymp
 
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public type & procedure
  !
  type, extends(modelcomponent), public :: atmoscomponent
    type(atmosvars) :: vars
 
    character(len=H_SHORT) :: mesh_type
    class(atmosmesh), pointer :: mesh
    type(atmosmeshrm) :: mesh_rm
    type(atmosmeshgm) :: mesh_gm
 
    type(atmosdyn) :: dyn_proc
    type(atmosphysfc) :: phy_sfc_proc
    type(atmosphytb ) :: phy_tb_proc
    type(atmosphymp ) :: phy_mp_proc
 
  contains
    procedure, public :: setup => atmos_setup 
    procedure, public :: setup_vars => atmos_setup_vars    
    procedure, public :: calc_tendency => atmos_calc_tendency
    procedure, public :: update => atmos_update
    procedure, public :: set_surface => atmos_set_surface
    procedure, public :: finalize => atmos_finalize
  end type atmoscomponent
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
 
!OCL SERIAL
  subroutine atmos_setup( this )
    use scale_const, only: &
      undef8 => const_undef8
    
    use scale_atmos_hydrometeor, only: &
      atmos_hydrometeor_dry,   &
      atmos_hydrometeor_regist    
    use scale_atmos_thermodyn, only: &
      atmos_thermodyn_setup
    use scale_atmos_saturation, only: &
      atmos_saturation_setup
 
    use scale_file_history_meshfield, only: &
      file_history_meshfield_setup  
    use scale_time_manager, only: &
      time_manager_regist_component
 
    implicit none
    
    class(atmoscomponent), intent(inout), target :: this
 
    logical :: ACTIVATE_FLAG = .true.
 
    real(DP) :: TIME_DT                             = undef8
    character(len=H_SHORT) :: TIME_DT_UNIT          = 'SEC'
    real(DP) :: TIME_DT_RESTART                     = undef8
    character(len=H_SHORT) :: TIME_DT_RESTART_UNIT  = 'SEC'
 
    logical :: ATMOS_DYN_DO    = .true.
    logical :: ATMOS_PHY_SF_DO = .false.
    logical :: ATMOS_PHY_TB_DO = .false.
    logical :: ATMOS_PHY_MP_DO = .false.  
    character(len=H_SHORT) :: ATMOS_MESH_TYPE = 'REGIONAL' ! 'REGIONAL' or 'GLOBAL'
 
    logical :: ATMOS_USE_QV    = .false.
 
    namelist / param_atmos / &
      activate_flag,         &
      time_dt,               &
      time_dt_unit,          &
      time_dt_restart,       &
      time_dt_restart_unit,  &
      atmos_mesh_type,       &
      atmos_dyn_do,          &
      atmos_phy_sf_do,       &
      atmos_phy_tb_do,       &
      atmos_phy_mp_do,       &    
      atmos_use_qv
    
    integer :: ierr
    !--------------------------------------------------
    call prof_rapstart( 'ATM_setup', 1)
    log_info('AtmosComponent_setup',*) 'Atmosphere model components '
    
    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_atmos,iostat=ierr)
    if( ierr < 0 ) then !--- missing
      log_info("ATMOS_setup",*) 'Not found namelist. Default used.'
    elseif( ierr > 0 ) then !--- fatal error
      log_error("ATM_setup",*) 'Not appropriate names in namelist PARAM_ATMOS. Check!'
      call prc_abort
    endif
    log_nml(param_atmos)
 
    !************************************************
    call this%ModelComponent_Init('ATMOS', activate_flag )
    if ( .not. activate_flag ) return
 
    !- Setup time manager
 
    call this%time_manager%Init( this%GetComponentName(), &
      time_dt, time_dt_unit,                              &
      time_dt_restart, time_dt_restart_unit               ) 
    
    call time_manager_regist_component( this%time_manager )
    
    !- Setup mesh & file I/O for atmospheric component
 
    this%mesh_type = atmos_mesh_type
    select case( this%mesh_type )
    case('REGIONAL')
      call this%mesh_rm%Init()
      call file_history_meshfield_setup( mesh3d_=this%mesh_rm%mesh )
      this%mesh => this%mesh_rm
    case('GLOBAL')
      call this%mesh_gm%Init()
      call file_history_meshfield_setup( meshcubedsphere3d_=this%mesh_gm%mesh )
      this%mesh => this%mesh_gm
    case default
      log_error("ATM_setup",*) 'Unsupported type of mesh is specified. Check!', this%mesh_type
      call prc_abort    
    end select
    
    !- setup common tools for atmospheric model
 
    call atmos_thermodyn_setup
    call atmos_saturation_setup
 
    !- Setup each processes in atmospheric model ------------------------------------
 
    !- Setup the module for atmosphere / physics / surface
    call this%phy_sfc_proc%ModelComponentProc_Init( 'AtmosPhysSfc', atmos_phy_sf_do )
    call this%phy_sfc_proc%setup( this%mesh, this%time_manager )
    
    !- Setup the module for atmosphere / physics / cloud microphysics
    call this%phy_mp_proc%ModelComponentProc_Init( 'AtmosPhysMp', atmos_phy_mp_do )
    call this%phy_mp_proc%setup( this%mesh, this%time_manager )
 
    !-- Regist qv if needed
    if ( atmos_hydrometeor_dry .and. atmos_use_qv ) then
      log_info("ATMOS_setup",*) "Regist QV"
      call atmos_hydrometeor_regist( 0, 0,                                 & ! (in)
        (/'QV'/),                                                          & ! (in)
        (/'Ratio of Water Vapor mass to total mass (Specific humidity)'/), & ! (in)
        (/'kg/kg'/),                                                       & ! (in)
        this%phy_mp_proc%vars%QS                                           ) ! (out)
      
      this%phy_mp_proc%vars%QA = 1
      this%phy_mp_proc%vars%QE = this%phy_mp_proc%vars%QS    
    end if
 
    !- Setup the module for atmosphere / dynamics 
    call this%dyn_proc%ModelComponentProc_Init( 'AtmosDyn', atmos_dyn_do )
    call this%dyn_proc%setup( this%mesh, this%time_manager )
 
    !- Setup the module for atmosphere / physics / turbulence
    call this%phy_tb_proc%ModelComponentProc_Init( 'AtmosPhysTb', atmos_phy_tb_do )
    call this%phy_tb_proc%setup( this%mesh, this%time_manager )
    call this%phy_tb_proc%SetDynBC( this%dyn_proc%dyncore_driver%boundary_cond )
 
    log_newline
    log_info('AtmosComponent_setup',*) 'Finish setup of each atmospheric components.'
 
    call prof_rapend( 'ATM_setup', 1)
 
    return
  end subroutine atmos_setup
 
!OCL SERIAL
  subroutine atmos_setup_vars( this )
    implicit none
 
    class(atmoscomponent), intent(inout) :: this
    !----------------------------------------------------------
 
    call prof_rapstart( 'ATM_setup_vars', 1)
 
    call this%vars%Init( this%mesh )
    call this%vars%Regist_physvar_manager( &
      this%phy_mp_proc%vars%auxvars2D_manager )
 
    call prof_rapend( 'ATM_setup_vars', 1)   
 
    return
  end subroutine atmos_setup_vars
 
!OCL SERIAL
  subroutine atmos_calc_tendency( this, force )
    use scale_tracer, only: qa
    use scale_atm_dyn_dgm_nonhydro3d_common, only: &
      phytend_num1 => phytend_num, &
      dens_tp => phytend_dens_id,  &
      momx_tp => phytend_momx_id,  &
      momy_tp => phytend_momy_id,  &
      momz_tp => phytend_momz_id,  &
      rhot_tp =>  phytend_rhot_id, &
      rhoh_p => phytend_rhoh_id    
    use mod_atmos_vars, only: &
      atmosvars_getlocalmeshphytends
 
    implicit none
    class(atmoscomponent), intent(inout) :: this
    logical, intent(in) :: force
 
 
    class(meshbase), pointer :: mesh
    class(localmesh3d), pointer :: lcmesh
    type(localmeshfieldbaselist) :: tp_list(PHYTEND_NUM1)
    type(localmeshfieldbaselist) :: tp_qtrc(QA)
 
    integer :: tm_process_id
    logical :: is_update
    integer :: n
    integer :: v
    integer :: iq
    integer :: ke
    !------------------------------------------------------------------
    
    call prof_rapstart( 'ATM_tendency', 1)
    !LOG_INFO('AtmosComponent_calc_tendency',*)
 
    call this%mesh%GetModelMesh( mesh )  
 
    !########## Get Surface Boundary from coupler ##########
    
    
    !########## calculate tendency ##########
 
    !* Exchange halo data ( for physics )
    call prof_rapstart( 'ATM_exchange_prgv', 2)
    call this%vars%PROGVARS_manager%MeshFieldComm_Exchange()
    if ( qa > 0 ) call this%vars%QTRCVARS_manager%MeshFieldComm_Exchange()
    call prof_rapend( 'ATM_exchange_prgv', 2)
 
    ! reset tendencies of physics
 
    do n=1, mesh%LOCAL_MESH_NUM
      call atmosvars_getlocalmeshphytends( n, mesh, this%vars%PHYTENDS_manager ,   & ! (in)
        tp_list(dens_tp)%ptr, tp_list(momx_tp)%ptr, tp_list(momy_tp)%ptr,          & ! (out)
        tp_list(momz_tp)%ptr, tp_list(rhot_tp)%ptr, tp_list(rhoh_p )%ptr, tp_qtrc, & ! (out)
        lcmesh                                                                     ) ! (out)
      
      !$omp parallel private(v,iq,ke)
      !$omp do collapse(2)
      do v=1, phytend_num1
      do ke=lcmesh%NeS, lcmesh%NeE
        tp_list(v)%ptr%val(:,ke) = 0.0_rp
      end do
      end do
      !$omp do collapse(2)
      do iq=1, qa
      do ke=lcmesh%NeS, lcmesh%NeE
        tp_qtrc(iq)%ptr%val(:,ke) = 0.0_rp
      end do
      end do
      !$omp end do
      !$omp end parallel
    end do
 
    ! Cloud Microphysics
 
    if ( this%phy_mp_proc%IsActivated() ) then
      call prof_rapstart('ATM_Microphysics', 1)
      tm_process_id = this%phy_mp_proc%tm_process_id
      is_update = this%time_manager%Do_process(tm_process_id) .or. force
      call this%phy_mp_proc%calc_tendency( &
          this%mesh, this%vars%PROGVARS_manager, this%vars%QTRCVARS_manager, &
          this%vars%AUXVARS_manager, this%vars%PHYTENDS_manager, is_update   )
      call prof_rapend('ATM_Microphysics', 1)
    end if
    
    ! Radiation
 
 
    ! Turbulence
 
    if ( this%phy_tb_proc%IsActivated() ) then
      call prof_rapstart('ATM_Turbulence', 1)
      tm_process_id = this%phy_tb_proc%tm_process_id
      is_update = this%time_manager%Do_process(tm_process_id) .or. force
      call this%phy_tb_proc%calc_tendency( &
          this%mesh, this%vars%PROGVARS_manager, this%vars%QTRCVARS_manager, &
          this%vars%AUXVARS_manager, this%vars%PHYTENDS_manager, is_update   )
      call prof_rapend('ATM_Turbulence', 1)
    end if
 
    ! Cumulus
 
 
!    if ( .not. CPL_sw ) then    
    
    ! Surface flux
    
    if ( this%phy_sfc_proc%IsActivated() ) then
      call prof_rapstart('ATM_SurfaceFlux', 1)
      tm_process_id = this%phy_sfc_proc%tm_process_id
      is_update = this%time_manager%Do_process(tm_process_id) .or. force
      call this%phy_sfc_proc%calc_tendency( &
          this%mesh, this%vars%PROGVARS_manager, this%vars%QTRCVARS_manager, &
          this%vars%AUXVARS_manager, this%vars%PHYTENDS_manager, is_update   )
      call prof_rapend('ATM_SurfaceFlux', 1)
    end if
    
    ! Planetary Boundary layer
 
!   end if
 
    call prof_rapend( 'ATM_tendency', 1)
    return  
  end subroutine atmos_calc_tendency
 
!OCL SERIAL
  subroutine atmos_update( this )
    implicit none
    class(atmoscomponent), intent(inout) :: this
    
    integer :: tm_process_id
    logical :: is_update
    integer :: inner_itr
    !--------------------------------------------------
    call prof_rapstart( 'ATM_update', 1)
 
    !########## Dynamics ########## 
 
    if ( this%dyn_proc%IsActivated() ) then
      call prof_rapstart('ATM_Dynamics', 1)
      tm_process_id = this%dyn_proc%tm_process_id
      is_update = this%time_manager%Do_process( tm_process_id )
 
      log_progress(*) 'atmosphere / dynamics'   
      do inner_itr=1, this%time_manager%Get_process_inner_itr_num( tm_process_id )
        call this%dyn_proc%update( &
          this%mesh, this%vars%PROGVARS_manager, this%vars%QTRCVARS_manager, &
          this%vars%AUXVARS_manager, this%vars%PHYTENDS_manager, is_update   )
      end do
      call prof_rapend('ATM_Dynamics', 1)
    end if
    
    !########## Calculate diagnostic variables ##########  
 
    call this%vars%Calc_diagnostics()
    call this%vars%AUXVARS_manager%MeshFieldComm_Exchange()
 
    !########## Adjustment ##########
    ! Microphysics
    ! Aerosol
    ! Lightning
 
    !########## Reference State ###########
 
    !#### Check values #################################
    call this%vars%Check()
 
    call prof_rapend('ATM_update', 1)
    return  
  end subroutine atmos_update
 
!OCL SERIAL
  subroutine atmos_set_surface( this )
    use mod_atmos_vars, only: &
      atmosvars_getlocalmeshsfcvar
    use mod_atmos_phy_mp_vars, only: &
      atmosphympvars_getlocalmeshfields_sfcflx
    implicit none
    class(atmoscomponent), intent(inout) :: this
 
    class(meshbase), pointer :: mesh
    class(meshbase2d), pointer :: mesh2D
    class(localmesh2d), pointer :: lcmesh
    integer :: n
    integer :: ke
 
    class(localmeshfieldbase), pointer :: PREC, PREC_ENGI
    class(localmeshfieldbase), pointer :: SFLX_rain_MP, SFLX_snow_MP, SFLX_ENGI_MP
 
    !--------------------------------------------------
 
    call prof_rapstart( 'ATM_sfc_exch', 1)
 
    call this%mesh%GetModelMesh( mesh )  
    select type(mesh)
    class is (meshbase3d)
      call mesh%GetMesh2D( mesh2d )
    end select
 
    !- sum of rainfall from mp and cp
 
    do n=1, mesh2d%LOCAL_MESH_NUM
      call atmosvars_getlocalmeshsfcvar( n, &
        mesh2d, this%vars%AUXVARS2D_manager, & ! (in)
        prec, prec_engi, lcmesh              ) ! (out)
 
      !$omp parallel do private(ke)
      do ke=lcmesh%NeS, lcmesh%NeE
        prec     %val(:,ke) = 0.0_rp
        prec_engi%val(:,ke) = 0.0_rp
      end do
 
      if ( this%phy_mp_proc%IsActivated() ) then
        call atmosphympvars_getlocalmeshfields_sfcflx( n, &
          mesh2d, this%phy_mp_proc%vars%auxvars2D_manager, & ! (in)
          sflx_rain_mp, sflx_snow_mp, sflx_engi_mp         ) ! (out)
 
        !$omp parallel do private(ke)
        do ke=lcmesh%NeS, lcmesh%NeE
          prec     %val(:,ke) = prec     %val(:,ke) + sflx_rain_mp%val(:,ke) + sflx_snow_mp%val(:,ke)
          prec_engi%val(:,ke) = prec_engi%val(:,ke) + sflx_engi_mp%val(:,ke)
        end do
      end if
   end do
 
    call prof_rapend( 'ATM_sfc_exch', 1)
 
    return
  end subroutine atmos_set_surface
 
!OCL SERIAL
  subroutine atmos_finalize( this )
    implicit none
    class(atmoscomponent), intent(inout) :: this
    !--------------------------------------------------
 
    log_info('AtmosComponent_finalize',*)
 
    if ( .not. this%IsActivated() ) return
 
    call this%dyn_proc%finalize()
    call this%phy_sfc_proc%finalize()
    call this%phy_tb_proc%finalize()
    call this%phy_mp_proc%finalize()
    
    call this%vars%Final()
 
    select case( this%mesh_type )
    case('REGIONAL')
      call this%mesh_rm%Final()
    case('GLOBAL')
      call this%mesh_gm%Final()
    end select  
    this%mesh => null()
 
    call this%time_manager%Final()
 
    return  
  end subroutine atmos_finalize
 
end module mod_atmos_component