mod_experiment.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
#include "scaleFElib.h"
module mod_experiment
  !-----------------------------------------------------------------------------
  !
  !++ Used modules
  !
  use scale_precision
  use scale_io
  use scale_prc
 
  use scale_const, only: &
    pi => const_pi,       &
    grav => const_grav,   &
    rdry => const_rdry,   &
    cpdry => const_cpdry, &
    cvdry => const_cvdry, &
    pres00 => const_pre00
 
  use scale_mesh_base3d, only: meshbase3d    
  use scale_mesh_cubedom3d, only: meshcubedom3d
  use scale_mesh_cubedspheredom3d, only: meshcubedspheredom3d
  use scale_meshfieldcomm_base, only: meshfieldcommbase
  use scale_meshfieldcomm_cubedom3d, only: meshfieldcommcubedom3d  
  use scale_meshfieldcomm_cubedspheredom3d, only: meshfieldcommcubedspheredom3d
  use scale_meshfield_base, only: meshfield3d
  use scale_element_base, only: elementbase3d
  use scale_element_hexahedral, only: hexahedralelement
  use scale_localmesh_3d, only: localmesh3d
  use scale_localmeshfield_base, only: localmeshfieldbase
 
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public type & procedures
  !
 
  type, public :: experiment
    character(len=H_SHORT) :: label
    procedure(exp_setinitcond_lc), pointer :: setinitcond_lc => null()
    procedure(exp_geostrophic_balance_correction_lc), pointer :: geostrophic_balance_correction_lc => null()
  contains
    procedure, public :: init_base => experiment_init
    generic :: init => init_base
    procedure, public :: final_base => experiment_final
    generic :: final => final_base
    procedure, public :: setinitcond => experiment_setinitcond
    procedure, public :: regist_setinitcond => experiment_regist_set_initcond
    procedure, public :: regist_geostrophic_balance_correction => experiment_regist_geostrophic_balance_correction
  end type experiment
 
  type, public :: tracerlocalmeshfield_ptr
    class(localmeshfieldbase), pointer :: ptr
  end type
 
  interface
    subroutine exp_setinitcond_lc( &
      this, DENS_hyd, PRES_hyd, DDENS, MOMX, MOMY, MOMZ, DRHOT,  &
      tracer_field_list,                                         &
      x, y, z, dom_xmin, dom_xmax, dom_ymin, dom_ymax, dom_zmin, &
      dom_zmax, lcmesh, elem )
 
      import experiment
      import localmesh3d 
      import elementbase3d
      import tracerlocalmeshfield_ptr
      import rp
 
      class(experiment), intent(inout) :: this
      type(localmesh3d), intent(in) :: lcmesh
      class(elementbase3d), intent(in) :: elem
      real(RP), intent(out) :: DENS_hyd(elem%Np,lcmesh%NeA)
      real(RP), intent(out) :: PRES_hyd(elem%Np,lcmesh%NeA)
      real(RP), intent(out) :: DDENS(elem%Np,lcmesh%NeA)
      real(RP), intent(out) :: MOMX(elem%Np,lcmesh%NeA)
      real(RP), intent(out) :: MOMY(elem%Np,lcmesh%NeA)
      real(RP), intent(out) :: MOMZ(elem%Np,lcmesh%NeA)
      real(RP), intent(out) :: DRHOT(elem%Np,lcmesh%NeA)
      type(tracerlocalmeshfield_ptr), intent(inout) :: tracer_field_list(:)
      real(RP), intent(in) :: x(elem%Np,lcmesh%Ne)
      real(RP), intent(in) :: y(elem%Np,lcmesh%Ne)
      real(RP), intent(in) :: z(elem%Np,lcmesh%Ne)
      real(RP), intent(in) :: dom_xmin, dom_xmax
      real(RP), intent(in) :: dom_ymin, dom_ymax      
      real(RP), intent(in) :: dom_zmin, dom_zmax
    end subroutine exp_setinitcond_lc
 
    subroutine exp_geostrophic_balance_correction_lc( this,                &
      DENS_hyd, PRES_hyd, DDENS, MOMX, MOMY, MOMZ, DRHOT,                  &
      lcmesh, elem )
    
      import experiment
      import localmesh3d 
      import elementbase3d
      import rp
 
      class(experiment), intent(inout) :: this
      type(localmesh3d), intent(in) :: lcmesh
      class(elementbase3d), intent(in) :: elem
      real(RP), intent(inout) :: DENS_hyd(elem%Np,lcmesh%NeA)
      real(RP), intent(in) :: PRES_hyd(elem%Np,lcmesh%NeA)
      real(RP), intent(inout) :: DDENS(elem%Np,lcmesh%NeA)
      real(RP), intent(inout) :: MOMX(elem%Np,lcmesh%NeA)
      real(RP), intent(inout) :: MOMY(elem%Np,lcmesh%NeA)    
      real(RP), intent(inout) :: MOMZ(elem%Np,lcmesh%NeA)
      real(RP), intent(inout) :: DRHOT(elem%Np,lcmesh%NeA)
    end subroutine exp_geostrophic_balance_correction_lc
  end interface
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  
  !-----------------------------------------------------------------------------
  !
  !++ Private procedures
  !
  !-------------------
 
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
 
contains
  subroutine experiment_init( this, exp_name )
    implicit none
    class(experiment), intent(inout) :: this
    character(len=*), intent(in) :: exp_name
    !----------------------------------------------------------------------
 
    this%label = exp_name
 
    this%setInitCond_lc => experiment_setinitcond_lc_dummy
    this%geostrophic_balance_correction_lc => experiment_geostrophic_balance_correction_lc_dummy
 
    return
  end subroutine experiment_init
 
  subroutine experiment_final( this )
    implicit none
    class(experiment), intent(inout) :: this
    !----------------------------------------------------------------------
 
    return
  end subroutine experiment_final
 
  subroutine experiment_regist_set_initcond( this, exp_SetInitCond_lc )
    implicit none
    class(experiment), intent(inout) :: this
    interface
      subroutine exp_setinitcond_lc( &
        this, &
        DENS_hyd, PRES_hyd, DDENS, MOMX, MOMY, MOMZ, DRHOT,  &
        tracer_field_list,                                         &
        x, y, z, dom_xmin, dom_xmax, dom_ymin, dom_ymax, dom_zmin, &
        dom_zmax, lcmesh, elem )
 
        import experiment
        import localmesh3d 
        import elementbase3d
        import tracerlocalmeshfield_ptr
        import rp
 
        class(experiment), intent(inout) :: this
        type(localmesh3d), intent(in) :: lcmesh
        class(elementbase3d), intent(in) :: elem
        real(RP), intent(out) :: DENS_hyd(elem%Np,lcmesh%NeA)
        real(RP), intent(out) :: PRES_hyd(elem%Np,lcmesh%NeA)
        real(RP), intent(out) :: DDENS(elem%Np,lcmesh%NeA)
        real(RP), intent(out) :: MOMX(elem%Np,lcmesh%NeA)
        real(RP), intent(out) :: MOMY(elem%Np,lcmesh%NeA)
        real(RP), intent(out) :: MOMZ(elem%Np,lcmesh%NeA)
        real(RP), intent(out) :: DRHOT(elem%Np,lcmesh%NeA)
        type(tracerlocalmeshfield_ptr), intent(inout) :: tracer_field_list(:)
        real(RP), intent(in) :: x(elem%Np,lcmesh%Ne)
        real(RP), intent(in) :: y(elem%Np,lcmesh%Ne)
        real(RP), intent(in) :: z(elem%Np,lcmesh%Ne)
        real(RP), intent(in) :: dom_xmin, dom_xmax
        real(RP), intent(in) :: dom_ymin, dom_ymax      
        real(RP), intent(in) :: dom_zmin, dom_zmax
      end subroutine exp_setinitcond_lc
    end interface    
    !----------------------------------------------------------------------
 
    this%setInitCond_lc => exp_setinitcond_lc
    return
  end subroutine experiment_regist_set_initcond
 
  subroutine experiment_regist_geostrophic_balance_correction( this, exp_geostrophic_balance_correction_lc )
    implicit none
    class(experiment), intent(inout) :: this
    interface
      subroutine exp_geostrophic_balance_correction_lc( this,                &
        DENS_hyd, PRES_hyd, DDENS, MOMX, MOMY, MOMZ, DRHOT,                  &
        lcmesh, elem )
      
        import experiment
        import localmesh3d 
        import elementbase3d
        import rp
 
        class(experiment), intent(inout) :: this
        type(localmesh3d), intent(in) :: lcmesh
        class(elementbase3d), intent(in) :: elem
        real(RP), intent(inout) :: DENS_hyd(elem%Np,lcmesh%NeA)
        real(RP), intent(in) :: PRES_hyd(elem%Np,lcmesh%NeA)
        real(RP), intent(inout) :: DDENS(elem%Np,lcmesh%NeA)
        real(RP), intent(inout) :: MOMX(elem%Np,lcmesh%NeA)
        real(RP), intent(inout) :: MOMY(elem%Np,lcmesh%NeA)    
        real(RP), intent(inout) :: MOMZ(elem%Np,lcmesh%NeA)
        real(RP), intent(inout) :: DRHOT(elem%Np,lcmesh%NeA)
      end subroutine exp_geostrophic_balance_correction_lc
    end interface
    !----------------------------------------------------------------------
 
    this%geostrophic_balance_correction_lc => exp_geostrophic_balance_correction_lc
    return
  end subroutine experiment_regist_geostrophic_balance_correction
 
  subroutine experiment_setinitcond( this, &
    model_mesh, atm_prgvars_manager, atm_auxvars_manager, atm_trcvars_manager )
    
    use scale_tracer, only: qa
 
    use scale_meshfield_base, only: meshfieldbase
    use scale_model_var_manager, only: modelvarmanager
    use scale_meshfieldcomm_base, only: meshfieldcontainer 
 
    use scale_atm_dyn_dgm_nonhydro3d_common, only: &
      auxvar_preshydro_id, &
      auxvar_denshydro_id
 
    use mod_atmos_vars, only: &
      atmosvars_getlocalmeshprgvars, &
      atmosvars_getlocalmeshqtrcvar
    use mod_atmos_mesh, only: atmosmesh
    
    implicit none
 
    class(experiment), intent(inout) :: this
    class(atmosmesh), target, intent(in) :: model_mesh
    class(modelvarmanager), intent(inout) :: atm_prgvars_manager
    class(modelvarmanager), intent(inout) :: atm_auxvars_manager
    class(modelvarmanager), intent(inout) :: atm_trcvars_manager
 
    class(localmeshfieldbase), pointer :: DDENS, MOMX, MOMY, MOMZ, DRHOT
    class(localmeshfieldbase), pointer :: DENS_hyd, PRES_hyd
    class(localmeshfieldbase), pointer :: Rtot, CVtot, CPtot
 
    integer :: n
    class(localmesh3d), pointer :: lcmesh3D
    class(meshbase3d), pointer :: mesh
 
    type(meshfieldcommcubedom3d), target :: hydvars_comm_rm
    type(meshfieldcommcubedspheredom3d), target :: hydvars_comm_gm
    class(meshfieldcommbase), pointer :: hydvars_comm
    type(meshfieldcontainer) :: hydvars_comm_list(1)
    class(meshfieldbase), pointer :: field_ptr
 
    type(tracerlocalmeshfield_ptr) :: tracer_field_list(max(1,QA))
    integer :: iq
    !----------------------------------------------------------------------
    
    mesh => model_mesh%ptr_mesh
    
    do n=1, mesh%LOCAL_MESH_NUM
      call atmosvars_getlocalmeshprgvars( n, &
        mesh, atm_prgvars_manager, atm_auxvars_manager, &
        ddens, momx, momy, momz, drhot,                 &
        dens_hyd, pres_hyd, rtot, cvtot, cptot,         &
        lcmesh3d                                        )
      
      do iq=1, qa
        call atmosvars_getlocalmeshqtrcvar( n, mesh, atm_trcvars_manager, &
          iq, tracer_field_list(iq)%ptr )
      end do
 
      select type (mesh)
      type is (meshcubedom3d)
        call this%setInitCond_lc( &
          dens_hyd%val, pres_hyd%val,                                                         & ! (out)
          ddens%val, momx%val, momy%val, momz%val, drhot%val,                                 & ! (out)
          tracer_field_list,                                                                  & ! (inout)
          lcmesh3d%pos_en(:,:,1), lcmesh3d%pos_en(:,:,2), lcmesh3d%pos_en(:,:,3),             & ! (in)
          mesh%xmin_gl, mesh%xmax_gl, mesh%ymin_gl, mesh%ymax_gl, mesh%zmin_gl, mesh%zmax_gl, & ! (in)
          lcmesh3d, lcmesh3d%refElem3D )                                                        ! (in) 
      type is (meshcubedspheredom3d)
        call this%setInitCond_lc( &
          dens_hyd%val, pres_hyd%val,                                                         & ! (out)
          ddens%val, momx%val, momy%val, momz%val, drhot%val,                                 & ! (out)
          tracer_field_list,                                                                  & ! (inout)          
          lcmesh3d%pos_en(:,:,1), lcmesh3d%pos_en(:,:,2), lcmesh3d%pos_en(:,:,3),             & ! (in)
          mesh%xmin_gl, mesh%xmax_gl, mesh%ymin_gl, mesh%ymax_gl, mesh%zmin_gl, mesh%zmax_gl, & ! (in)
          lcmesh3d, lcmesh3d%refElem3D )                                                        ! (in)   
      end select
    end do
 
    !------------------------------------------------------
 
    call atm_auxvars_manager%Get(auxvar_preshydro_id, field_ptr)
    select type(field_ptr) 
    type is (meshfield3d)
      hydvars_comm_list(1)%field3d => field_ptr
    end select
    select type (mesh)
    type is (meshcubedom3d)
      call hydvars_comm_rm%Init(1, 0, 0, mesh)
      hydvars_comm => hydvars_comm_rm
    type is (meshcubedspheredom3d)
      call hydvars_comm_gm%Init(1, 0, 0, mesh)
      hydvars_comm => hydvars_comm_gm
    end select
 
    call hydvars_comm%Put(hydvars_comm_list, 1)
    call hydvars_comm%Exchange()
    call hydvars_comm%Get(hydvars_comm_list, 1)
 
    !--------------------------------
    do n=1, mesh%LOCAL_MESH_NUM
      call atmosvars_getlocalmeshprgvars( n, &
        mesh, atm_prgvars_manager, atm_auxvars_manager, &
        ddens, momx, momy, momz, drhot,                 &
        dens_hyd, pres_hyd, rtot, cvtot, cptot,         &
        lcmesh3d                                        )
 
      call this%geostrophic_balance_correction_lc( &
        dens_hyd%val, pres_hyd%val,                          & ! (out)
        ddens%val, momx%val, momy%val, momz%val, drhot%val,  & ! (out)
        lcmesh3d, lcmesh3d%refElem3D )                         ! (in) 
    end do
 
    call atm_auxvars_manager%Get(auxvar_denshydro_id, field_ptr)
    select type(field_ptr) 
    type is (meshfield3d)
      hydvars_comm_list(1)%field3d => field_ptr
    end select
    call hydvars_comm%Put(hydvars_comm_list, 1)
    call hydvars_comm%Exchange()
    call hydvars_comm%Get(hydvars_comm_list, 1)
 
    select type (mesh)
    type is (meshcubedom3d)
      call hydvars_comm_rm%Final()
    type is (meshcubedspheredom3d)
      call hydvars_comm_gm%Final()
    end select    
 
    return
  end subroutine experiment_setinitcond
  
  !------
!OCL SERIAL  
  subroutine experiment_setinitcond_lc_dummy( this,                   &
    DENS_hyd, PRES_hyd, DDENS, MOMX, MOMY, MOMZ, DRHOT, tracer_field_list, &
    x, y, z, dom_xmin, dom_xmax, dom_ymin, dom_ymax, dom_zmin, dom_zmax,   &
    lcmesh, elem )
    implicit none
 
    class(experiment), intent(inout) :: this
    type(localmesh3d), intent(in) :: lcmesh
    class(elementbase3d), intent(in) :: elem
    real(RP), intent(out) :: DENS_hyd(elem%Np,lcmesh%NeA)
    real(RP), intent(out) :: PRES_hyd(elem%Np,lcmesh%NeA)
    real(RP), intent(out) :: DDENS(elem%Np,lcmesh%NeA)
    real(RP), intent(out) :: MOMX(elem%Np,lcmesh%NeA)
    real(RP), intent(out) :: MOMY(elem%Np,lcmesh%NeA)    
    real(RP), intent(out) :: MOMZ(elem%Np,lcmesh%NeA)
    real(RP), intent(out) :: DRHOT(elem%Np,lcmesh%NeA)
    type(tracerlocalmeshfield_ptr), intent(inout) :: tracer_field_list(:)    
    real(RP), intent(in) :: x(elem%Np,lcmesh%Ne)
    real(RP), intent(in) :: y(elem%Np,lcmesh%Ne)
    real(RP), intent(in) :: z(elem%Np,lcmesh%Ne)
    real(RP), intent(in) :: dom_xmin, dom_xmax
    real(RP), intent(in) :: dom_ymin, dom_ymax
    real(RP), intent(in) :: dom_zmin, dom_zmax
    !---------------------------------------------------
 
    return
  end subroutine experiment_setinitcond_lc_dummy
 
  subroutine experiment_geostrophic_balance_correction_lc_dummy( this,    &
    DENS_hyd, PRES_hyd, DDENS, MOMX, MOMY, MOMZ, DRHOT,   &
    lcmesh, elem )
    
    implicit none
    class(experiment), intent(inout) :: this
    type(localmesh3d), intent(in) :: lcmesh
    class(elementbase3d), intent(in) :: elem
    real(RP), intent(inout) :: DENS_hyd(elem%Np,lcmesh%NeA)
    real(RP), intent(in) :: PRES_hyd(elem%Np,lcmesh%NeA)
    real(RP), intent(inout) :: DDENS(elem%Np,lcmesh%NeA)
    real(RP), intent(inout) :: MOMX(elem%Np,lcmesh%NeA)
    real(RP), intent(inout) :: MOMY(elem%Np,lcmesh%NeA)    
    real(RP), intent(inout) :: MOMZ(elem%Np,lcmesh%NeA)
    real(RP), intent(inout) :: DRHOT(elem%Np,lcmesh%NeA)
    !---------------------------------------------------
    return
  end subroutine experiment_geostrophic_balance_correction_lc_dummy
 
end module mod_experiment