mod_atmos_mesh_gm.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scaleFElib.h"
module mod_atmos_mesh_gm
  !-----------------------------------------------------------------------------
  !
  !++ Used modules
  !
  use scale_precision
  use scale_io
  use scale_prc
 
  use scale_meshfield_base, only: meshfield3d
  use scale_mesh_base3d, only: meshbase3d
  use scale_mesh_cubedspheredom3d, only: meshcubedspheredom3d
  use scale_element_base, only: elementbase3d
  use scale_element_hexahedral, only: hexahedralelement
  use scale_localmesh_3d, only: localmesh3d
  use scale_meshfieldcomm_cubedspheredom3d, only: meshfieldcommcubedspheredom3d
  use scale_sparsemat, only: sparsemat
  use scale_file_base_meshfield, only: file_base_meshfield
  use scale_file_restart_meshfield, only: file_restart_meshfield_component
 
  use scale_model_var_manager, only: modelvarmanager
  use scale_model_mesh_manager, only: modelmesh3d
 
  use mod_atmos_mesh, only: &
    atmosmesh, atm_mesh_max_commnuicator_num
  
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public type & procedures
  !
 
  type, extends(atmosmesh), public :: atmosmeshgm
    type(meshcubedspheredom3d) :: mesh
    type(meshfieldcommcubedspheredom3d) :: comm_list(atm_mesh_max_commnuicator_num)
  contains
    procedure :: init => atmosmeshgm_init
    procedure :: final => atmosmeshgm_final
    procedure :: create_communicator => atmosmeshgm_create_communicator
    procedure :: setup_restartfile1 => atmosmeshgm_setup_restartfile1
    procedure :: setup_restartfile2 => atmosmeshgm_setup_restartfile2
    procedure :: calc_uvmet => atmosmeshgm_calc_uvmet
    procedure :: setup_vcoordinate => atmosmeshgm_setup_vcoordinate
  end type atmosmeshgm
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  
  !-----------------------------------------------------------------------------
  !
  !++ Private procedures
  !
  !-------------------
 
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
 
contains
 
!OCL SERIAL
  subroutine atmosmeshgm_init( this )    
    use scale_const, only: &
      rplanet => const_radius
    use scale_mesh_base2d, only: &
      mftype2d_xy => meshbase2d_dimtypeid_xy
    use scale_meshutil_vcoord, only: &
      meshutil_get_vcoord_typeid
    
    implicit none
    class(atmosmeshgm), target, intent(inout) :: this
 
    real(RP) :: dom_zmin          = 0.0_rp      
    real(RP) :: dom_zmax          = 10.0e3_rp   
    logical  :: isPeriodicZ       = .false.     
  
    integer, parameter :: FZ_nmax = 1000
    real(RP) :: FZ(FZ_nmax)
 
    !* Global
    logical :: SHALLOW_ATM_APPROX_FLAG = .true.  
    integer  :: NeGX               = 2
    integer  :: NeGY               = 2
    integer  :: NeZ                = 2
    integer  :: NLocalMeshPerPrc   = 6
    integer  :: Nprc               = 1
    integer  :: PolyOrder_h        = 2
    integer  :: PolyOrder_v        = 2
    logical  :: LumpedMassMatFlag  = .false.     
 
    character(len=H_LONG) :: TOPO_IN_BASENAME    = ''
    character(len=H_MID)  :: TOPO_IN_VARNAME     = 'topo'
    character(len=H_MID)  :: VERTICAL_COORD_NAME = "TERRAIN_FOLLOWING"
 
    logical :: COMM_USE_MPI_PC    = .false.      
 
    character(len=H_SHORT) :: Element_operation_type = 'General'
    character(len=H_SHORT) :: SpMV_storage_format    = 'ELL'
    
    namelist / param_atmos_mesh / &
      shallow_atm_approx_flag,                     &
      dom_zmin, dom_zmax,                          &
      fz, isperiodicz,                             &
      negx, negy, nez, nlocalmeshperprc, nprc,     &
      polyorder_h, polyorder_v, lumpedmassmatflag, &
      element_operation_type,                      &
      spmv_storage_format,                         &
      vertical_coord_name,                         &
      topo_in_basename, topo_in_varname,           &
      comm_use_mpi_pc
    
    integer :: k
    logical :: is_spec_FZ
    
    integer :: ierr
 
    type(file_base_meshfield) :: file_topo
    !-------------------------------------------
 
    log_newline
    log_info("ATMOS_MESH_setup",*) 'Setup'
 
    fz(:) = -1.0_rp
 
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_atmos_mesh,iostat=ierr)
    if( ierr < 0 ) then !--- missing
      log_info("ATMOS_MESH_setup",*) 'Not found namelist. Default used.'
    elseif( ierr > 0 ) then !--- fatal error
      log_error("ATMOS_MESH_setup",*) 'Not appropriate names in namelist PARAM_ATM_MESH. Check!'
      call prc_abort
    endif
    log_nml(param_atmos_mesh)
 
    !----
 
    !- Setup the element
 
    call this%element%Init( polyorder_h, polyorder_v, lumpedmassmatflag )
    call this%element_v1D%Init( polyorder_v, lumpedmassmatflag )
 
    !- Setup the mesh
 
    is_spec_fz = .true.
    do k=1, nez+1
      if (fz(k) < 0.0_rp) then
        is_spec_fz = .false.
      end if
    end do
    if (is_spec_fz) then
      call this%mesh%Init( &
        negx, negy, nez, rplanet, dom_zmin, dom_zmax,          &
        this%element, nlocalmeshperprc, nproc=nprc,            &
        fz=fz(1:nez+1), shallow_approx=shallow_atm_approx_flag )
    else
      call this%mesh%Init( &
        negx, negy, nez, rplanet, dom_zmin, dom_zmax, &
        this%element, nlocalmeshperprc, nproc=nprc,   &
        shallow_approx=shallow_atm_approx_flag        )
    end if
    
    call this%mesh%Generate()
    
    !-
 
    call this%AtmosMesh_Init( this%mesh )
    call this%PrepairElementOperation( element_operation_type, spmv_storage_format )
 
    !- Set topography & vertical coordinate
    
    if ( topo_in_basename /= '' ) then
      log_info("ATMOS_MESH_setup",*) 'Read topography data'
 
      call file_topo%Init(1, meshcubedsphere2d=this%mesh%mesh2D )
      call file_topo%Open( topo_in_basename, myrank=prc_myrank )
      call file_topo%Read_Var( mftype2d_xy, topo_in_varname, this%topography%topo )
      call file_topo%Close()
      call file_topo%Final()
    end if
 
    this%vcoord_type_id = meshutil_get_vcoord_typeid( vertical_coord_name )
    call this%Setup_vcoordinate()
 
    !-
    this%comm_use_mpi_pc = comm_use_mpi_pc
 
    return
  end subroutine atmosmeshgm_init
 
!OCL SERIAL
  subroutine atmosmeshgm_final(this)
    implicit none
 
    class(atmosmeshgm), intent(inout) :: this
    integer :: commid
    !-------------------------------------------
 
    do commid=1, this%communicator_num
      call this%comm_list(commid)%Final()
    end do
 
    call this%mesh%Final()
    call this%AtmosMesh_Final()
    
    return
  end subroutine atmosmeshgm_final
 
!OCL SERIAL
  subroutine atmosmeshgm_create_communicator( this, sfield_num, hvfield_num, htensorfield_num, &
    var_manager, field_list, commid )
    implicit none
    class(atmosmeshgm), target, intent(inout) :: this
    integer, intent(in) :: sfield_num
    integer, intent(in) :: hvfield_num
    integer, intent(in) :: htensorfield_num
    class(modelvarmanager), intent(inout) :: var_manager
    class(meshfield3d), intent(in) :: field_list(:)
    integer, intent(out) :: commid
    !-----------------------------------------------------
 
    commid = this%Get_communicatorID( atm_mesh_max_commnuicator_num )
    call this%comm_list(commid)%Init( sfield_num, hvfield_num, htensorfield_num, this%mesh )
    if ( this%comm_use_mpi_pc ) call this%comm_list(commid)%Prepare_PC()
    call var_manager%MeshFieldComm_Prepair( this%comm_list(commid), field_list )
 
    return
  end subroutine atmosmeshgm_create_communicator  
 
!OCL SERIAL
  subroutine atmosmeshgm_setup_restartfile1( this, restart_file, var_num )
    implicit none
    class(atmosmeshgm), target, intent(inout) :: this
    class(file_restart_meshfield_component), intent(inout) :: restart_file
    integer, intent(in) :: var_num  
    !------------------------------------------------
 
    call restart_file%Init('ATMOS', var_num, meshcubedsphere3d=this%mesh )
    return
  end subroutine atmosmeshgm_setup_restartfile1
 
!OCL SERIAL
  subroutine atmosmeshgm_setup_restartfile2( this, restart_file, &
    in_basename, in_postfix_timelabel,                         &
    out_basename, out_postfix_timelabel,                       &
    out_dtype, out_title, var_num                              )
    implicit none
    class(atmosmeshgm), target, intent(inout) :: this
    class(file_restart_meshfield_component), intent(inout) :: restart_file
    character(*), intent(in) :: in_basename
    logical, intent(in) :: in_postfix_timelabel
    character(*), intent(in) :: out_basename
    logical, intent(in) :: out_postfix_timelabel
    character(*), intent(in) :: out_title
    character(*), intent(in) :: out_dtype  
    integer, intent(in) :: var_num  
    !-----------------------------------------------------------
 
    call restart_file%Init('ATMOS', in_basename, in_postfix_timelabel,    &
      out_basename, out_postfix_timelabel, out_dtype, out_title, var_num, &
      meshcubedsphere3d=this%mesh )
 
  end subroutine atmosmeshgm_setup_restartfile2
 
!OCL SERIAL
  subroutine atmosmeshgm_calc_uvmet( this, U, V, &
    Umet, Vmet )
 
    use scale_cubedsphere_coord_cnv, only: &
      cubedspherecoordcnv_cs2lonlatvec
    implicit none
    class(atmosmeshgm), target, intent(in) :: this
    type(meshfield3d), intent(in) :: U
    type(meshfield3d), intent(in) :: V
    type(meshfield3d), intent(inout) :: Umet
    type(meshfield3d), intent(inout) :: Vmet
 
    integer :: n
    integer :: ke, ke2D
    type(localmesh3d), pointer :: lcmesh
    class(elementbase3d), pointer :: elem
    !------------------------------------------
 
    do n=1, this%mesh%LOCAL_MESH_NUM
      lcmesh => this%mesh%lcmesh_list(n)
      elem => lcmesh%refElem3D
      call cubedspherecoordcnv_cs2lonlatvec( &
        lcmesh%panelID, lcmesh%pos_en(:,:,1), lcmesh%pos_en(:,:,2), & ! (in)
        lcmesh%gam, elem%Np * lcmesh%Ne,                            & ! (in)
        u%local(n)%val(:,lcmesh%NeS:lcmesh%NeE),                    & ! (in)
        v%local(n)%val(:,lcmesh%NeS:lcmesh%NeE),                    & ! (in)
        umet%local(n)%val(:,lcmesh%NeS:lcmesh%NeE),                 & ! (out)
        vmet%local(n)%val(:,lcmesh%NeS:lcmesh%NeE)                  ) ! (out)
    end do
 
    return
  end subroutine atmosmeshgm_calc_uvmet
 
!OCL SERIAL
  subroutine atmosmeshgm_setup_vcoordinate( this )
    use scale_meshfieldcomm_cubedspheredom2d, only: meshfieldcommcubedspheredom2d
    implicit none
    class(atmosmeshgm), TARGET, INTENT(INOUT) :: this
 
    type(meshfieldcommcubedspheredom3d) :: comm3D
    type(meshfieldcommcubedspheredom2d) :: comm2D
    !-------------------------------------------------
 
    call comm2d%Init( 1, 0, 0, this%mesh%mesh2D )
    call comm3d%Init( 2, 1, 0, this%mesh )
 
    call this%topography%SetVCoordinate( this%ptr_mesh,   &
      this%vcoord_type_id, this%mesh%zmax_gl, comm3d, comm2d )
 
    call comm2d%Final()
    call comm3d%Final()
 
    return
  end SUBROUTINE atmosmeshgm_setup_vcoordinate
 
end module mod_atmos_mesh_gm