mod_atmos_phy_mp_vars.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scaleFElib.h"
module mod_atmos_phy_mp_vars
  !-----------------------------------------------------------------------------
  !
  !++ Used modules
  !
  use scale_precision
  use scale_io
  use scale_prc
 
  use scale_element_base, only: elementbase3d
  use scale_mesh_base, only: meshbase
  use scale_mesh_base2d, only: meshbase2d
  use scale_mesh_base3d, only: &
    meshbase3d,                              &
    dimtype_xyz  => meshbase3d_dimtypeid_xyz
  use scale_localmesh_base, only: localmeshbase
  use scale_localmesh_3d, only: localmesh3d
  use scale_localmeshfield_base, only: &
    localmeshfieldbase, localmeshfieldbaselist
  use scale_meshfield_base, only: &
    meshfieldbase, meshfield2d, meshfield3d
 
  use scale_file_restart_meshfield, only: &
    file_restart_meshfield_component
  
  use scale_meshfieldcomm_base, only: meshfieldcontainer
  
  use scale_model_var_manager, only: &
    modelvarmanager, variableinfo
  use scale_model_mesh_manager, only: modelmeshbase
    
  use mod_atmos_mesh, only: atmosmesh
 
  !-----------------------------------------------------------------------------
  implicit none
  private
 
 
  !-----------------------------------------------------------------------------
  !
  !++ Public type & procedures
  !
  type, public :: atmosphympvars
    type(meshfield3d), allocatable :: tends(:)
    type(modelvarmanager) :: tends_manager
 
    type(meshfield2d), allocatable :: auxvars2d(:)
    type(modelvarmanager) :: auxvars2d_manager
 
    integer :: qs
    integer :: qe
    integer :: qa
 
    integer :: tends_num_tot 
    integer, allocatable :: vterm_hist_id(:)
    type(meshfield3d), allocatable :: vterm_hist(:)
  contains
    procedure :: init => atmosphympvars_init
    procedure :: final => atmosphympvars_final
    procedure :: history => atmosphympvars_history
  end type atmosphympvars
 
  public :: atmosphympvars_getlocalmeshfields_tend
  public :: atmosphympvars_getlocalmeshfields_sfcflx
 
  !-----------------------------------------------------------------------------
  !
  !++ Public variables
  !
 
  integer, public, parameter :: atmos_phy_mp_dens_t_id    = 1  
  integer, public, parameter :: atmos_phy_mp_momx_t_id    = 2
  integer, public, parameter :: atmos_phy_mp_momy_t_id    = 3
  integer, public, parameter :: atmos_phy_mp_momz_t_id    = 4
  integer, public, parameter :: atmos_phy_mp_rhot_t_id    = 5
  integer, public, parameter :: atmos_phy_mp_rhoh_id      = 6 
  integer, public, parameter :: atmos_phy_mp_evaporate_id = 7
  integer, public, parameter :: atmos_phy_mp_tends_num1   = 7 
 
  type(variableinfo), public :: atmos_phy_mp_tend_vinfo(atmos_phy_mp_tends_num1)
  DATA atmos_phy_mp_tend_vinfo / &
    variableinfo( atmos_phy_mp_dens_t_id, 'MP_DENS_t', 'tendency of x-momentum in MP process',           &
                   'kg/m3/s',  3, 'XYZ',  ''                                                          ), &
    variableinfo( atmos_phy_mp_momx_t_id, 'MP_MOMX_t', 'tendency of x-momentum in MP process',           &
                  'kg/m2/s2',  3, 'XYZ',  ''                                                          ), &
    variableinfo( atmos_phy_mp_momy_t_id, 'MP_MOMY_t', 'tendency of y-momentum in MP process',           &
                  'kg/m2/s2',  3, 'XYZ',  ''                                                          ), &
    variableinfo( atmos_phy_mp_momz_t_id, 'MP_MOMZ_t', 'tendency of z-momentum in MP process',           &
                  'kg/m2/s2',  3, 'XYZ',  ''                                                          ), &
    variableinfo( atmos_phy_mp_rhot_t_id, 'MP_RHOT_t', 'tendency of rho*PT in MP process',               &
                  'kg/m3.K/s', 3, 'XYZ',  ''                                                          ), &
    variableinfo( atmos_phy_mp_rhoh_id  , 'mp_RHOH', 'diabatic heating rate in MP process',              &
                  'J/kg/s',   3, 'XYZ',  ''                                                           ), & 
    variableinfo( atmos_phy_mp_evaporate_id, 'mp_EVAPORATE', 'number concentration of evaporated cloud', &
                  'm-3'   ,   3, 'XYZ',  ''                                                           )  /                   
 
 
  integer, public, parameter :: atmos_phy_mp_aux2d_sflx_rain_id   = 1
  integer, public, parameter :: atmos_phy_mp_aux2d_sflx_snow_id   = 2
  integer, public, parameter :: atmos_phy_mp_aux2d_sflx_engi_id   = 3
  integer, public, parameter :: atmos_phy_mp_aux2d_num            = 3
 
  type(variableinfo), public :: atmos_phy_mp_aux2d_vinfo(atmos_phy_mp_aux2d_num)
  DATA atmos_phy_mp_aux2d_vinfo / &
    variableinfo( atmos_phy_mp_aux2d_sflx_rain_id, 'MP_SFLX_RAIN', 'precipitation flux (liquid) in MP process',    &
                  'kg/m2/s',  2, 'XY',  ''                                                                      ), &
    variableinfo( atmos_phy_mp_aux2d_sflx_snow_id, 'MP_SFLX_SNOW', 'precipitation flux (solid) in MP process',     &
                  'kg/m2/s',  2, 'XY',  ''                                                                      ), &
    variableinfo( atmos_phy_mp_aux2d_sflx_engi_id, 'MP_SFLX_ENGI', 'internal energy flux flux in MP process',      &
                  'J/m2/s',   2, 'XY',  ''                                                                      )  /
 
  
  !-----------------------------------------------------------------------------
  !
  !++ Private procedures
  !
  !-------------------
 
contains
!OCL SERIAL
  subroutine atmosphympvars_init( this, model_mesh, &
    QS_MP, QE_MP, QA_MP )
 
    use scale_tracer, only: &
      tracer_name, tracer_desc, tracer_unit
    use scale_file_history, only: &
      file_history_reg
 
    implicit none
    class(atmosphympvars), target, intent(inout) :: this
    class(modelmeshbase), target, intent(in) :: model_mesh
    integer, intent(in) :: qs_mp
    integer, intent(in) :: qe_mp
    integer, intent(in) :: qa_mp
 
    integer :: iv
    integer :: iq
    integer :: n
    logical :: reg_file_hist
 
    class(atmosmesh), pointer :: atm_mesh
    class(meshbase2d), pointer :: mesh2d
    class(meshbase3d), pointer :: mesh3d
 
    type(variableinfo) :: qtrc_tp_vinfo_tmp
    type(variableinfo) :: qtrc_vterm_vinfo_tmp
    !--------------------------------------------------
 
    log_info('AtmosPhyMpVars_Init',*)
 
    this%QS = qs_mp
    this%QE = qe_mp
    this%QA = qa_mp
    this%TENDS_NUM_TOT = atmos_phy_mp_tends_num1 + qe_mp - qs_mp + 1
 
    !- Initialize auxiliary and diagnostic variables
 
    nullify( atm_mesh )
    select type(model_mesh)
    class is (atmosmesh)
      atm_mesh => model_mesh
    end select
    mesh3d => atm_mesh%ptr_mesh
    
    call mesh3d%GetMesh2D( mesh2d )
 
    !----
 
    call this%tends_manager%Init()
    allocate( this%tends(this%TENDS_NUM_TOT) )
 
    reg_file_hist = .true.    
    do iv = 1, atmos_phy_mp_tends_num1
      call this%tends_manager%Regist(           &
        atmos_phy_mp_tend_vinfo(iv), mesh3d,    &
        this%tends(iv), reg_file_hist           )
      
      do n = 1, mesh3d%LOCAL_MESH_NUM
        this%tends(iv)%local(n)%val(:,:) = 0.0_rp
      end do         
    end do
 
    qtrc_tp_vinfo_tmp%ndims    = 3
    qtrc_tp_vinfo_tmp%dim_type = 'XYZ'
    qtrc_tp_vinfo_tmp%STDNAME  = ''
    
    do iq = 1, this%QA
      iv = atmos_phy_mp_tends_num1 + iq 
      qtrc_tp_vinfo_tmp%keyID = iv
      qtrc_tp_vinfo_tmp%NAME  = 'MP_'//trim(tracer_name(this%QS+iq-1))//'_t'
      qtrc_tp_vinfo_tmp%DESC  = 'tendency of rho*'//trim(tracer_name(this%QS+iq-1))//' in MP process'
      qtrc_tp_vinfo_tmp%UNIT  = 'kg/m3/s'
 
      reg_file_hist = .true.
      call this%tends_manager%Regist( &
        qtrc_tp_vinfo_tmp, mesh3d,              & 
        this%tends(iv), reg_file_hist           ) 
      
      do n = 1, mesh3d%LOCAL_MESH_NUM
        this%tends(iv)%local(n)%val(:,:) = 0.0_rp
      end do         
    end do    
 
    !--
    
    allocate( this%vterm_hist_id(this%QS+1:this%QE) )
    allocate( this%vterm_hist   (this%QS+1:this%QE) )
 
    qtrc_vterm_vinfo_tmp%ndims    = 3
    qtrc_vterm_vinfo_tmp%dim_type = 'XYZ'
    qtrc_vterm_vinfo_tmp%STDNAME  = ''
 
    do iq = this%QS+1, this%QE
      qtrc_vterm_vinfo_tmp%NAME = 'Vterm_'//trim(tracer_name(this%QS+iq-1))
      qtrc_vterm_vinfo_tmp%DESC = 'terminal velocity of '//trim(tracer_name(this%QS+iq-1))
      qtrc_vterm_vinfo_tmp%UNIT = 'm/s'
      call file_history_reg( qtrc_vterm_vinfo_tmp%NAME, qtrc_vterm_vinfo_tmp%DESC, qtrc_vterm_vinfo_tmp%UNIT, &
        this%vterm_hist_id(iq), dim_type='XYZ'                                              )
      if ( this%vterm_hist_id(iq) > 0 ) call this%vterm_hist(iq)%Init( qtrc_vterm_vinfo_tmp%NAME, qtrc_vterm_vinfo_tmp%UNIT, mesh3d )
    end do
 
    !--
    
    call this%auxvars2D_manager%Init()
    allocate( this%auxvars2D(atmos_phy_mp_aux2d_num) )
 
    reg_file_hist = .true.    
    do iv = 1, atmos_phy_mp_aux2d_num
      call this%auxvars2D_manager%Regist( &
        atmos_phy_mp_aux2d_vinfo(iv), mesh2d,    & ! (in) 
        this%auxvars2D(iv), reg_file_hist        ) ! (out)
      
      do n = 1, mesh3d%LOCAL_MESH_NUM
        this%auxvars2D(iv)%local(n)%val(:,:) = 0.0_rp
      end do         
    end do
    
    return
  end subroutine atmosphympvars_init
 
!OCL SERIAL
  subroutine atmosphympvars_final( this )
    implicit none
    class(atmosphympvars), intent(inout) :: this
 
    integer :: iq
    !--------------------------------------------------
 
    log_info('AtmosPhyMpVars_Final',*)
 
    call this%tends_manager%Final()
    deallocate( this%tends )
 
    call this%auxvars2D_manager%Final()
    deallocate( this%auxvars2D )
 
    do iq = this%QS+1, this%QE
      if ( this%vterm_hist_id(iq) > 0 ) call this%vterm_hist(iq)%Final()
    end do
    deallocate( this%vterm_hist_id )
 
    return
  end subroutine atmosphympvars_final
 
!OCL SERIAL
  subroutine atmosphympvars_getlocalmeshfields_tend( domID, mesh, mp_tends_list, &
    mp_DENS_t, mp_MOMX_t, mp_MOMY_t, mp_MOMZ_t, mp_RHOT_t, mp_RHOH, mp_EVAP,     &
    mp_RHOQ_t,                                                                   &
    lcmesh3D                                                                     &
    )
 
    use scale_mesh_base, only: meshbase
    use scale_meshfield_base, only: meshfieldbase
    implicit none
 
    integer, intent(in) :: domid
    class(meshbase), intent(in) :: mesh
    class(modelvarmanager), intent(inout) :: mp_tends_list
    class(localmeshfieldbase), pointer, intent(out) :: mp_dens_t    
    class(localmeshfieldbase), pointer, intent(out) :: mp_momx_t
    class(localmeshfieldbase), pointer, intent(out) :: mp_momy_t
    class(localmeshfieldbase), pointer, intent(out) :: mp_momz_t
    class(localmeshfieldbase), pointer, intent(out) :: mp_rhot_t
    class(localmeshfieldbase), pointer, intent(out) :: mp_rhoh
    class(localmeshfieldbase), pointer, intent(out) :: mp_evap
    type(localmeshfieldbaselist), intent(out) :: mp_rhoq_t(:)
    class(localmesh3d), pointer, intent(out), optional :: lcmesh3d
 
    class(meshfieldbase), pointer :: field   
    class(localmeshbase), pointer :: lcmesh
 
    integer :: iq
    !-------------------------------------------------------
 
    !--
    call mp_tends_list%Get(atmos_phy_mp_dens_t_id, field)
    call field%GetLocalMeshField(domid, mp_dens_t)
 
    call mp_tends_list%Get(atmos_phy_mp_momx_t_id, field)
    call field%GetLocalMeshField(domid, mp_momx_t)
 
    call mp_tends_list%Get(atmos_phy_mp_momy_t_id, field)
    call field%GetLocalMeshField(domid, mp_momy_t)
 
    call mp_tends_list%Get(atmos_phy_mp_momz_t_id, field)
    call field%GetLocalMeshField(domid, mp_momz_t)
 
    call mp_tends_list%Get(atmos_phy_mp_rhot_t_id, field)
    call field%GetLocalMeshField(domid, mp_rhot_t)
 
    call mp_tends_list%Get(atmos_phy_mp_rhoh_id, field)
    call field%GetLocalMeshField(domid, mp_rhoh)
 
    call mp_tends_list%Get(atmos_phy_mp_evaporate_id, field)
    call field%GetLocalMeshField(domid, mp_evap)
 
    !---
    do iq = 1, size(mp_rhoq_t)
      call mp_tends_list%Get(atmos_phy_mp_tends_num1 + iq, field)
      call field%GetLocalMeshField(domid, mp_rhoq_t(iq)%ptr)
    end do
 
    
    if (present(lcmesh3d)) then
      call mesh%GetLocalMesh( domid, lcmesh )
      nullify( lcmesh3d )
 
      select type(lcmesh)
      type is (localmesh3d)
        if (present(lcmesh3d)) lcmesh3d => lcmesh
      end select
    end if
 
    return
  end subroutine atmosphympvars_getlocalmeshfields_tend
 
!OCL SERIAL
  subroutine atmosphympvars_getlocalmeshfields_sfcflx( domID, mesh, sfcflx_list, &
    SFLX_rain, SFLX_snow, SFLX_engi                                              )
    
    use scale_mesh_base, only: meshbase
    use scale_meshfield_base, only: meshfieldbase
    implicit none
 
    integer, intent(in) :: domid
    class(meshbase), intent(in) :: mesh
    class(modelvarmanager), intent(inout) :: sfcflx_list
    class(localmeshfieldbase), pointer, intent(out) :: sflx_rain
    class(localmeshfieldbase), pointer, intent(out) :: sflx_snow
    class(localmeshfieldbase), pointer, intent(out) :: sflx_engi
 
    class(meshfieldbase), pointer :: field
    !-------------------------------------------------------
 
    call sfcflx_list%Get(atmos_phy_mp_aux2d_sflx_rain_id, field)
    call field%GetLocalMeshField(domid, sflx_rain)
 
    call sfcflx_list%Get(atmos_phy_mp_aux2d_sflx_snow_id, field)
    call field%GetLocalMeshField(domid, sflx_snow)
 
    call sfcflx_list%Get(atmos_phy_mp_aux2d_sflx_engi_id, field)
    call field%GetLocalMeshField(domid, sflx_engi)
    
    return
  end subroutine atmosphympvars_getlocalmeshfields_sfcflx
 
!OCL SERIAL
  subroutine atmosphympvars_history( this )
    use scale_file_history_meshfield, only: file_history_meshfield_put
    implicit none
    class(atmosphympvars), intent(inout) :: this
  
    integer :: v
    integer :: iq
    integer :: hst_id
    type(meshfield3d) :: tmp_field
    class(meshbase3d), pointer :: mesh3d
    !-------------------------------------------------------------------------
 
    mesh3d => this%tends(1)%mesh
 
    do v = 1, this%TENDS_NUM_TOT
      hst_id = this%tends(v)%hist_id
      if ( hst_id > 0 ) call file_history_meshfield_put( hst_id, this%tends(v) )
    end do
 
    do v = 1, atmos_phy_mp_aux2d_num
      hst_id = this%auxvars2D(v)%hist_id
      if ( hst_id > 0 ) call file_history_meshfield_put( hst_id, this%auxvars2D(v) )
    end do
 
    do iq = this%QS+1, this%QE
      hst_id = this%vterm_hist_id(iq)
      if ( hst_id > 0 ) call file_history_meshfield_put( hst_id, this%vterm_hist(iq) )
    end do
 
    return
  end subroutine atmosphympvars_history
 
end  module mod_atmos_phy_mp_vars