mod_dg_prep.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scaleFElib.h"
module mod_dg_prep
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
  use scale_prof
  use scale_prc
 
  use mod_atmos_component, only: &
    atmoscomponent
  
  use scale_file_history_meshfield, only: &
    file_history_meshfield_write
  use scale_file_history, only: &
    file_history_set_nowdate
 
  use mod_user, only: &
    user
  use mod_mktopo, only: &
    mktopo, mktopo_write
  use mod_mkinit, only: &
    mkinit
  
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ included parameters
  !
#include "scale-dg.h" 
 
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: dg_prep
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  character(len=H_MID), private, parameter :: MODELNAME = "SCALE-DG ver. "//version
 
  type(AtmosComponent) :: atmos
  type(User) :: user_
 
contains
  subroutine dg_prep(                     &
    comm_world, cnf_fname, path, add_path )
 
    use scale_time_manager, only: &
      time_manager_checkstate, time_manager_advance,          &
      time_nowdate, time_nowsubsec, time_nowstep, time_nstep, &
      time_doresume, time_doend
 
    implicit none
 
    integer,          intent(in) :: comm_world
    character(len=*), intent(in) :: cnf_fname
    character(len=*), intent(in) :: path
    logical,          intent(in) :: add_path
 
 
    integer :: myrank
    logical :: ismaster
 
    logical :: output
    logical :: output_topo
    !---------------------------------------------------------------------------
 
    !########## Initial setup ##########
 
#ifdef SCALE_DEVELOP
    ! setup standard I/O
    if ( add_path .and. path /= "" ) then
      call io_setup( modelname, trim(path)//cnf_fname, prefix=path )
    else
#endif
      call io_setup( modelname, trim(path)//cnf_fname )
#ifdef SCALE_DEVELOP
    end if
#endif
 
    ! setup MPI
    call prc_local_setup( comm_world, & ! [IN]
                          myrank,     & ! [OUT]
                          ismaster    ) ! [OUT]
 
    ! setup Log
    call io_log_setup( myrank, ismaster )
 
    call initialize()
 
    !###########################################################################
 
    !########## main ##########
    call prof_setprefx('MAIN')
    call prof_rapstart('Main_prep', 0)
 
    !- Execute preprocess
 
    !- Execute mktopo
    call prof_rapstart('MkTopo',1)
    call mktopo( output_topo,           &
      atmos%mesh, atmos%mesh%topography )
    call prof_rapend  ('MkTopo',1)
 
    !- Re-setup
    call atmos%mesh%Setup_vcoordinate()
 
    !- Execute mkinit
    call prof_rapstart('MkInit',1)
    call mkinit( output, &
      atmos%mesh,                  &
      atmos%vars%PROGVARS_manager, &
      atmos%vars%AUXVARS_manager,  &
      atmos%vars%QTRCVARS_manager  )
    
!    call USER_mkinit( atmos )
    call user_%mkinit( atmos )
    if ( atmos%dyn_proc%dyncore_driver%ENTOT_CONSERVE_SCHEME_FLAG ) then
      call set_total_energy( atmos%vars%PROGVARS_manager, &
        atmos%vars%AUXVARS_manager, atmos%mesh )      
    end if
 
    call prof_rapend  ('MkInit',1)
    call prof_rapend('Main_prep', 0)
 
    !- Output
 
    if ( output_topo ) call mktopo_write( atmos%mesh, atmos%mesh%topography )
 
    if ( output ) then
      call prof_rapstart('MkInit_restart',1)
      call restart_write()
      call prof_rapend  ('MkInit_restart',1)
    end if
 
    !########## Finalize ##########
    call user_%mkfinal()
    call finalize()    
 
    return
  end subroutine dg_prep
 
  !----------------------------
  
  subroutine initialize()
 
    use scale_const, only: const_setup
    use scale_calendar, only: calendar_setup
    use scale_random, only: random_setup
    use scale_atmos_hydrometeor, only: atmos_hydrometeor_setup    
 
    use scale_file_restart_meshfield, only: &
      file_restart_meshfield_setup
    use scale_time_manager, only: time_manager_init
 
    use mod_mktopo, only: mktopo_setup
    use mod_mkinit, only: mkinit_setup
 
    implicit none
 
    !----------------------------------------------
 
    ! namelist compatibility check
    !call ADMIN_versioncheck
 
    ! setup PROF
    call prof_setup
 
    call prof_setprefx('INIT')
    call prof_rapstart('Initialize', 0)
    
    ! setup constants
    call const_setup
 
    ! setup calendar & initial time
    call calendar_setup
    call time_manager_init( .false. )
 
    ! setup random number
    call random_setup
 
    ! setup tracer index
    call atmos_hydrometeor_setup
 
    ! setup a module for restart file
    call file_restart_meshfield_setup
 
    ! setup submodels
    call  atmos%setup()
    call user_%setup( atmos )
 
    call atmos%setup_vars()
 
    ! setup mktopo
    call mktopo_setup
 
    ! setup mkinit
    call mkinit_setup()
 
    call prof_rapend('Initialize', 0)
 
    return
  end subroutine initialize
 
  subroutine finalize()
    use scale_file_history_meshfield, only: file_history_meshfield_finalize
    use scale_time_manager, only: time_manager_final   
    implicit none
    
    !----------------------------------------------
    call prof_setprefx('FIN')
    call prof_rapstart('All', 1)
 
    !-
    call file_history_meshfield_finalize()
 
    ! finalization submodels
    call  atmos%finalize()
 
    !-
    call time_manager_final()
 
    call prof_rapend  ('All', 1)
    call prof_rapreport()
 
    return
  end subroutine finalize
 
  subroutine set_total_energy( atm_prgvars_manager, & ! (inout)
      atm_auxvars_manager, model_mesh               ) 
  
    use scale_mesh_base3d, only: meshbase3d
    use scale_localmesh_3d, only: localmesh3d
    use scale_localmeshfield_base, only: localmeshfieldbase
    use scale_model_var_manager, only: modelvarmanager
    use scale_atm_dyn_dgm_nonhydro3d_common, only: &
      atm_dyn_dgm_nonhydro3d_common_drhot2entot
 
    use mod_atmos_mesh, only: atmosmesh
    use mod_atmos_vars, only: &
      atmosvars_getlocalmeshprgvars
 
    implicit none
 
    class(modelvarmanager), intent(inout) :: atm_prgvars_manager
    class(modelvarmanager), intent(inout) :: atm_auxvars_manager
    class(atmosmesh), target, intent(in) :: model_mesh
 
    class(localmeshfieldbase), pointer :: ddens, momx, momy, momz, therm
    class(localmeshfieldbase), pointer :: dens_hyd, pres_hyd
    class(localmeshfieldbase), pointer :: rtot, cptot, cvtot
 
    integer :: n
    integer :: ke
    class(localmesh3d), pointer :: lcmesh3d
    class(meshbase3d), pointer :: mesh
 
    real(rp), allocatable :: drhot_save(:,:)
    !---------------------------------------------------------------------------
 
    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, therm,                 &
        dens_hyd, pres_hyd, rtot, cvtot, cptot,         &
        lcmesh3d                                        )
      
      allocate( drhot_save(lcmesh3d%refElem3D%Np,lcmesh3d%NeA) )
      !$omp parallel do
      do ke=lcmesh3d%NeS, lcmesh3d%NeE
        drhot_save(:,ke) = therm%val(:,ke)
      end do
 
      call atm_dyn_dgm_nonhydro3d_common_drhot2entot( therm%val, &
        ddens%val, momx%val, momy%val, momz%val, drhot_save,        &
        dens_hyd%val, pres_hyd%val, rtot%val, cvtot%val, cptot%val, &
        lcmesh3d, lcmesh3d%refElem3D                                )
  
      deallocate( drhot_save )
    end do
 
    return
  end subroutine set_total_energy
 
  subroutine restart_write
    implicit none    
    !----------------------------------------
 
    if ( atmos%isActivated() ) call atmos%vars%Write_restart_file()
 
    return
  end subroutine restart_write
 
end module mod_dg_prep