mod_atmos_phy_tb.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scaleFElib.h"
module mod_atmos_phy_tb
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !  
  use scale_precision
  use scale_prc
  use scale_io
  use scale_prof
  use scale_const, only: &
    undef8 => const_undef8
  use scale_tracer, only: qa
 
  use scale_mesh_base, only: meshbase
  use scale_mesh_base2d, only: meshbase2d
  use scale_mesh_base3d, only: meshbase3d
 
  use scale_localmesh_base, only: localmeshbase
  use scale_localmesh_2d, only: localmesh2d
  use scale_localmesh_3d, only: localmesh3d
  use scale_element_base, only: &
    elementbase, elementbase2d, elementbase3d
    
  use scale_meshfield_base, only: meshfieldbase
  use scale_localmeshfield_base, only: &
    localmeshfieldbase, localmeshfieldbaselist
 
  use scale_model_mesh_manager, only: modelmeshbase
  use scale_model_var_manager, only: modelvarmanager
  use scale_model_component_proc, only:  modelcomponentproc
 
  use scale_atm_dyn_dgm_bnd, only: atmdynbnd
  
  use scale_atm_phy_tb_dgm_driver, only: &
    atmphytbdgmdriver
  use mod_atmos_phy_tb_vars, only: atmosphytbvars
 
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public type & procedure
  !
 
  type, extends(modelcomponentproc), public :: atmosphytb
    integer :: tb_typeid
    type(atmphytbdgmdriver) :: tb_driver
 
    type(atmosphytbvars) :: vars
    type(atmdynbnd), pointer :: dyn_bnd
  contains
    procedure, public :: setup => atmosphytb_setup 
    procedure, public :: calc_tendency => atmosphytb_calc_tendency
    procedure, public :: update => atmosphytb_update
    procedure, public :: finalize => atmosphytb_finalize
    procedure, public :: setdynbc => atmosphytb_setdynbc
  end type atmosphytb
 
  !-----------------------------------------------------------------------------
  !++ Public parameters & variables
  !-----------------------------------------------------------------------------
 
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
    
contains
!OCL SERIAL
  subroutine atmosphytb_setup( this, model_mesh, tm_parent_comp )
    use mod_atmos_mesh, only: atmosmesh
    use scale_time_manager, only: time_manager_component
 
    implicit none
    class(atmosphytb), intent(inout) :: this
    class(modelmeshbase), target, intent(in) :: model_mesh
    class(time_manager_component), intent(inout) :: tm_parent_comp
 
    real(DP) :: TIME_DT                             = undef8  
    character(len=H_SHORT) :: TIME_DT_UNIT          = 'SEC'
 
    character(len=H_MID) :: TB_TYPE = 'SMAGORINSKY'
    namelist /param_atmos_phy_tb/ &
      time_dt,          & 
      time_dt_unit,     &
      tb_type
    
    class(atmosmesh), pointer     :: atm_mesh
    class(meshbase), pointer      :: ptr_mesh
    real(DP) :: dtsec
 
    integer :: ierr
    !--------------------------------------------------
 
    if (.not. this%IsActivated()) return
 
    log_newline
    log_info("ATMOS_PHY_TB_setup",*) 'Setup'
 
    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_atmos_phy_tb,iostat=ierr)
    if( ierr < 0 ) then !--- missing
      log_info("ATMOS_PHY_TB_setup",*) 'Not found namelist. Default used.'
    elseif( ierr > 0 ) then !--- fatal error
      log_error("ATMOS_PHY_TB_setup",*) 'Not appropriate names in namelist PARAM_ATMOS_PHY_TB. Check!'
      call prc_abort
    endif
    log_nml(param_atmos_phy_tb)
 
    !- get mesh --------------------------------------------------
 
    call model_mesh%GetModelMesh( ptr_mesh )
    select type(model_mesh)
    class is (atmosmesh)
      atm_mesh => model_mesh
    end select
 
    !--- Regist this compoent in the time manager
    
    call tm_parent_comp%Regist_process( 'ATMOS_PHY_TB', time_dt, time_dt_unit, & ! (in)
      this%tm_process_id )                                                       ! (out)
 
    dtsec = tm_parent_comp%process_list(this%tm_process_id)%dtsec
 
    !- initialize the variables 
    call this%vars%Init( model_mesh )      
 
    !- Initialize a module for turbulence model
    call this%tb_driver%Init( tb_type, dtsec, atm_mesh )
 
    !--
    this%dyn_bnd => null()
 
    return
  end subroutine atmosphytb_setup
 
!OCL SERIAL
  subroutine atmosphytb_calc_tendency( &
    this, model_mesh, prgvars_list, trcvars_list, &
    auxvars_list, forcing_list, is_update         )
 
    use scale_tracer, only: &
      tracer_advc   
    use scale_atm_dyn_dgm_nonhydro3d_common, only: &
      prgvar_ddens_id
    use mod_atmos_vars, only: &
      atmosvars_getlocalmeshprgvars,    &
      atmosvars_getlocalmeshprgvar,     &
      atmosvars_getlocalmeshqtrcvar,    &
      atmosvars_getlocalmeshphyauxvars, &
      atmosvars_getlocalmeshphytends
    use mod_atmos_phy_tb_vars, only:          &
      atmosphytbvars_getlocalmeshfields_tend
     
    implicit none
    
    class(atmosphytb), intent(inout) :: this
    class(modelmeshbase), intent(in) :: model_mesh
    class(modelvarmanager), intent(inout) :: prgvars_list
    class(modelvarmanager), intent(inout) :: trcvars_list    
    class(modelvarmanager), intent(inout) :: auxvars_list
    class(modelvarmanager), intent(inout) :: forcing_list
    logical, intent(in) :: is_update
 
    class(meshbase), pointer :: mesh
    class(meshbase3d), pointer :: mesh3D
    class(localmesh3d), pointer :: lcmesh
    integer :: n
    integer :: ke
    integer :: iq
 
    class(localmeshfieldbase), pointer :: DENS_tp, MOMX_tp, MOMY_tp, MOMZ_tp, RHOT_tp, RHOH_P
    type(localmeshfieldbaselist) :: RHOQ_tp(QA)
    class(localmeshfieldbase), pointer :: tb_MOMX_t, tb_MOMY_t, tb_MOMZ_t, tb_RHOT_t
    class(localmeshfieldbase), pointer :: tb_RHOQ_t
    type(localmeshfieldbaselist) :: tb_RHOQ_t_list(QA)
    !--------------------------------------------------
 
    if (.not. this%IsActivated()) return
 
    !LOG_INFO('AtmosDyn_tendency',*)
 
    log_progress(*) 'atmosphere / physics / turbulence'
 
    call model_mesh%GetModelMesh( mesh )
    select type(mesh)
    class is (meshbase3d)
      mesh3d => mesh
    end select
 
    if (is_update) then
      call this%tb_driver%Tendency( this%vars%tends_manager, &
        prgvars_list, trcvars_list, auxvars_list,                                  &
        this%vars%auxvars_manager, this%vars%diagvars_manager,                     &
        this%dyn_bnd,                                                              &
        model_mesh%DOptrMat(1), model_mesh%DOptrMat(2), model_mesh%DOptrMat(3),    &
        model_mesh%SOptrMat(1), model_mesh%SOptrMat(2), model_mesh%SOptrMat(3),    &
        model_mesh%LiftOptrMat, mesh3d                                             )
    end if
      
    call prof_rapstart('ATM_PHY_TB_add_tend', 2)
    do n=1, mesh%LOCAL_MESH_NUM
      call atmosvars_getlocalmeshphytends( n,        &
        mesh, forcing_list,                          &
        dens_tp, momx_tp, momy_tp, momz_tp, rhot_tp, &
        rhoh_p, rhoq_tp  )
 
      call atmosphytbvars_getlocalmeshfields_tend( n,               &
        mesh, this%vars%tends_manager,                              &
        tb_momx_t, tb_momy_t, tb_momz_t, tb_rhot_t, tb_rhoq_t_list, &
        lcmesh                                                      )
 
      !$omp parallel private(ke, iq)
      !$omp do
      do ke=lcmesh%NeS, lcmesh%NeE
        momx_tp%val(:,ke) = momx_tp%val(:,ke) + tb_momx_t%val(:,ke)
        momy_tp%val(:,ke) = momy_tp%val(:,ke) + tb_momy_t%val(:,ke)
        momz_tp%val(:,ke) = momz_tp%val(:,ke) + tb_momz_t%val(:,ke)
        rhot_tp%val(:,ke) = rhot_tp%val(:,ke) + tb_rhot_t%val(:,ke)
      end do
      !$omp end do    
      do iq = 1, qa
        if ( .not. tracer_advc(iq) ) cycle
        !$omp do
        do ke = lcmesh%NeS, lcmesh%NeE
          rhoq_tp(iq)%ptr%val(:,ke) = rhoq_tp(iq)%ptr%val(:,ke)        &
                                    + tb_rhoq_t_list(iq)%ptr%val(:,ke)
        end do
        !$omp end do
      end do
      !$omp end parallel
    end do
    call prof_rapend('ATM_PHY_TB_add_tend', 2)
 
    return  
  end subroutine atmosphytb_calc_tendency
 
!OCL SERIAL
  subroutine atmosphytb_update( this, model_mesh, prgvars_list, trcvars_list, auxvars_list, forcing_list, is_update )
    implicit none
 
    class(atmosphytb), intent(inout) :: this
    class(modelmeshbase), intent(in) :: model_mesh
    class(modelvarmanager), intent(inout) :: prgvars_list
    class(modelvarmanager), intent(inout) :: trcvars_list    
    class(modelvarmanager), intent(inout) :: auxvars_list
    class(modelvarmanager), intent(inout) :: forcing_list
    logical, intent(in) :: is_update
    !--------------------------------------------------
 
    return
  end subroutine atmosphytb_update
 
!OCL SERIAL
  subroutine atmosphytb_finalize( this )
    implicit none
    class(atmosphytb), intent(inout) :: this
 
    !--------------------------------------------------
    if (.not. this%IsActivated()) return
 
    call this%tb_driver%Final()
    call this%vars%Final()
 
    return
  end subroutine atmosphytb_finalize
 
!OCL SERIAL
  subroutine atmosphytb_setdynbc( this, dyn_bnd )
    implicit none
    class(atmosphytb), intent(inout) :: this
    type(atmdynbnd), intent(in), target :: dyn_bnd
    !--------------------------------------------------
 
    this%dyn_bnd => dyn_bnd
 
    return
  end subroutine atmosphytb_setdynbc
  
!- private ------------------------------------------------
 
end module mod_atmos_phy_tb