mod_dg_driver.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!> module SCALE-DG (a main routine of regional/global model)
!!
!! @par Description
!!          SCALE: Scalable Computing by Advanced Library and Environment
!!          SCALE-DG: Regional / global model with atmospheric dynamical core based on DGM
!!
!! @author Yuta Kawai, Team SCALE
!!
!<
!-------------------------------------------------------------------------------
#include "scaleFElib.h"
module mod_dg_driver
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
  use scale_prof
  use scale_prc
 
  use scale_file_history_meshfield, only: &
    file_history_meshfield_write
  use scale_file_history, only: &
    file_history_set_nowdate
  use scale_file_monitor_meshfield, only: &
    file_monitor_meshfield_write
  
  use mod_atmos_component, only: &
    atmoscomponent
  use mod_ocean_component, only: &
    oceancomponent
  use mod_cpl_component, only: &
    couplercomponent
  use mod_user, only: &
    user
 
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ included parameters
  !
#include "scale-dg.h" 
 
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: dg_driver
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  character(len=H_MID), private, parameter :: MODELNAME = "SCALE-DG ver. "//version
 
  type(AtmosComponent) :: atmos
  type(OceanComponent) :: ocean
  type(CouplerComponent) :: coupler
  type(User) :: user_
 
contains
!OCL SERIAL
  subroutine dg_driver(     &
    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
    integer :: fpm_counter
    logical :: ismaster
    logical :: sign_exit
    !---------------------------------------------------------------------------
 
    !########## Initial setup ##########
 
    ! setup standard I/O
    if ( add_path .and. path /= "" ) then
      call io_setup( modelname, trim(path)//cnf_fname, prefix=path )
    else
      call io_setup( modelname, trim(path)//cnf_fname )
    end if
 
    ! setup MPI
    call prc_local_setup( comm_world, & ! [IN]
                          myrank,     & ! [OUT]
                          ismaster    ) ! [OUT]
 
    ! setup Log
    call io_log_setup( myrank, ismaster )
 
    call initialize
 
    !###########################################################################
 
    !########## main ##########
 
#ifdef FIPP
    call fipp_start
#endif
 
    log_newline
    log_progress(*) 'START TIMESTEP'
    call prof_setprefx('MAIN')
    call prof_rapstart('Main_Loop', 0)
 
    do
 
      !*******************************************
 
      ! report current time
      call time_manager_checkstate
 
      if (time_doresume) then
        ! set state from restart file
        call restart_read
        ! history & monitor file output 
        call file_monitor_meshfield_write('MAIN', time_nowstep)
        call file_history_meshfield_write
      end if   
      
      !* Advance time *********************************
 
      call time_manager_advance
      call file_history_set_nowdate( time_nowdate, time_nowsubsec, time_nowstep )
      
      !* change to next state *************************
 
      !- USER
      call user_%update_pre( atmos )
 
      if ( ocean%IsActivated() .and. ocean%time_manager%do_step ) call ocean%update()
      if ( atmos%IsActivated() .and. atmos%time_manager%do_step ) call atmos%update()
      call user_%update( atmos )
 
      !* restart and monitor output *******************
      if ( atmos%IsActivated() ) call atmos%vars%Monitor()
      call restart_write
      call file_monitor_meshfield_write('MAIN', time_nowstep)
 
 
      !* calc tendencies and diagnostics *************
 
      if ( atmos  %IsActivated() .and. atmos%time_manager%do_step ) call atmos%calc_tendency( force=.false. )
      if ( ocean  %IsActivated() .and. ocean%time_manager%do_step ) call ocean%calc_tendency( force=.false. )
      if ( coupler%IsActivated() .and. atmos%time_manager%do_step ) call atmos%calc_tendency_from_sflux(force=.false.)
      call user_%calc_tendency( atmos )
  
      !* output history files *************************
 
      if ( atmos%IsActivated() ) call atmos%vars%History()
      if ( atmos%dyn_proc%IsActivated() ) call atmos%dyn_proc%dyn_vars%History()
      if ( atmos%phy_tb_proc%IsActivated() ) call atmos%phy_tb_proc%vars%History()
      if ( atmos%phy_mp_proc%IsActivated() ) call atmos%phy_mp_proc%vars%History()
      if ( atmos%phy_sfc_proc%IsActivated() ) call atmos%phy_sfc_proc%vars%History()
      if ( atmos%phy_rd_proc%IsActivated() ) call atmos%phy_rd_proc%vars%History()
      if ( atmos%phy_bl_proc%IsActivated() ) call atmos%phy_bl_proc%vars%History()
      if ( atmos%phy_cp_proc%IsActivated() ) call atmos%phy_cp_proc%vars%History()
 
      if ( ocean%IsActivated() ) call ocean%vars%History()
 
      call file_history_meshfield_write
      
      !*******************************************
      if (time_doend) exit
      
      if( io_l ) call flush(io_fid_log)
    end do
 
    call prof_rapend('Main_Loop', 0)
 
    log_progress(*) 'END TIMESTEP'
    log_newline
 
#ifdef FIPP
    call fipp_stop
#endif
 
    !########## Finalize ##########
    call finalize
 
    return
  end subroutine dg_driver
 
  !----------------------------
  
!OCL SERIAL
  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_time_manager, only: time_dtsec
 
    use scale_time_manager, only:           &
      time_manager_init,                    &
      time_manager_report_timeintervals
    use scale_meshfield_statistics, only:   &
      meshfield_statistics_setup
    use scale_file_restart_meshfield, only: &
      restart_file,                         &
      file_restart_meshfield_setup
    use scale_file_monitor_meshfield, only: &
      file_monitor_meshfield_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
 
    ! setup random number
    call random_setup
 
    ! setup tracer index
    call atmos_hydrometeor_setup
 
    ! setup a module for restart file
    call file_restart_meshfield_setup
    call time_manager_init( &
      setup_timeintegration = .true.,                   &
      restart_in_basename   =  restart_file%in_basename )
 
    ! setup statistics
    call meshfield_statistics_setup
 
    ! setup monitor
    call file_monitor_meshfield_setup( time_dtsec )
 
    ! setup sub-models
    call atmos%setup()
    call ocean%setup()
    call coupler%setup()
    call user_%setup( atmos )
 
    call coupler%evaluate_activation( ocean )
    call atmos%set_coupler( coupler )
    call ocean%set_coupler( coupler )
 
    call atmos%setup_vars()
 
    if ( ocean%IsActivated() ) call ocean%setup_vars()
    if ( coupler%IsActivated() ) call coupler%setup_vars( atmos%mesh%ptr_mesh, ocean%mesh%ptr_mesh )
    
    ! report information of time intervals
    call time_manager_report_timeintervals
 
    !----------------------------------------
 
    call prof_rapend('Initialize', 0)
 
    return
  end subroutine initialize
 
!OCL SERIAL  
  subroutine finalize()
    use scale_file, only: &
      file_close_all
    use scale_file_history_meshfield, only: &
      file_history_meshfield_finalize
    use scale_file_restart_meshfield, only: &
      file_restart_meshfield_finalize
    use scale_file_monitor_meshfield, only: &
      file_monitor_meshfield_final
    use scale_time_manager, only: &
      time_manager_final   
    implicit none
    
    !----------------------------------------------
    call prof_setprefx('FIN')
    call prof_rapstart('All', 1)
 
    call prof_rapstart('Monit', 2)
    call file_monitor_meshfield_final
    call prof_rapend  ('Monit', 2)
 
    !-
    call prof_rapstart('File', 2)
    call file_history_meshfield_finalize
    call file_restart_meshfield_finalize
    call prof_rapend  ('File', 2)
 
    ! finalization sub-models
    call atmos%finalize()
    call ocean%finalize()
    call coupler%finalize()
    call user_%final()
 
    !-
    call time_manager_final
 
    call prof_rapend  ('All', 1)
    call prof_rapreport
 
    return
  end subroutine finalize
 
!OCL SERIAL
  subroutine restart_read()
    implicit none
    !----------------------------------------
 
    !- read restart data
 
    if ( atmos%isActivated() ) then
      call atmos%vars%Read_restart_file( atmos%mesh, atmos%dyn_proc%dyncore_driver )
      if ( atmos%phy_rd_proc%IsActivated() ) call atmos%phy_rd_proc%vars%Read_restart_file()
    end if
    if ( ocean%isActivated() ) then
      call ocean%vars%Read_restart_file( ocean%mesh )
    end if
 
    !- Setup surface condition
 
    if ( atmos%isActivated() ) call atmos%set_surface( countup=.false. )
    if ( ocean%isActivated() ) call ocean%set_surface( countup=.false. )
 
    !- Calculate the tendencies
 
    if ( atmos%IsActivated() ) call atmos%calc_tendency( force= .true. )
    if ( ocean%IsActivated() ) call ocean%calc_tendency( force= .true. )
    if ( coupler%IsActivated() ) call atmos%calc_tendency_from_sflux(force=.true.)
 
    call user_%calc_tendency( atmos )
 
    !- History & Monitor 
 
    if ( atmos%isActivated() ) then
      call atmos%vars%History()
      if ( atmos%phy_sfc_proc%IsActivated() ) call atmos%phy_sfc_proc%vars%History()
      if ( atmos%phy_tb_proc%IsActivated() ) call atmos%phy_tb_proc%vars%History()
      if ( atmos%phy_mp_proc%IsActivated() ) call atmos%phy_mp_proc%vars%History()
      if ( atmos%phy_rd_proc%IsActivated() ) call atmos%phy_rd_proc%vars%History()
      if ( atmos%phy_bl_proc%IsActivated() ) call atmos%phy_bl_proc%vars%History()
      if ( atmos%phy_cp_proc%IsActivated() ) call atmos%phy_cp_proc%vars%History()
      call atmos%vars%Monitor()
    end if
 
    if ( ocean%isActivated() ) then
      call ocean%vars%History()
    end if
 
    return
  end subroutine restart_read
 
!OCL SERIAL
  subroutine restart_write()
    use scale_file_restart_meshfield, only: &
      restart_file    
    implicit none
 
    logical :: is_restart_write_atmos
    logical :: is_restart_write_ocean
    !----------------------------------------
 
    if ( .not. restart_file%flag_output ) return
    
    is_restart_write_atmos = atmos%isActivated() .and. atmos%time_manager%do_restart
    is_restart_write_ocean  = ocean%isActivated()  .and. ocean%time_manager%do_restart
 
    !- Preprocess
    if ( is_restart_write_atmos ) then
      call atmos%vars%Write_restart_file_prep()
      if ( atmos%phy_rd_proc%IsActivated() ) call atmos%phy_rd_proc%vars%Write_restart_file_prep()
    end if
    if ( is_restart_write_ocean ) then
      call ocean%vars%Write_restart_file_prep()
    end if
 
    !- Write
    if ( is_restart_write_atmos ) then
      call atmos%vars%Write_restart_file()
      if ( atmos%phy_rd_proc%IsActivated() ) call atmos%phy_rd_proc%vars%Write_restart_file()
    end if
    if ( is_restart_write_ocean ) then
      call ocean%vars%Write_restart_file()
    end if
 
    !- Postprocess
    if ( is_restart_write_atmos ) then
      call atmos%vars%Write_restart_file_post()
      if ( atmos%phy_rd_proc%IsActivated() ) call atmos%phy_rd_proc%vars%Write_restart_file_post()
    end if
    if ( is_restart_write_ocean ) call ocean%vars%Write_restart_file_post()
 
    return
  end subroutine restart_write
 
 
end module mod_dg_driver