scale_file_restart_meshfield.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!> module FElib / File / Restart
!!
!! @par Description
!!           A module for outputting data to restart simulations
!!
!! @author Yuta Kawai, Team SCALE
!!
!<
!-------------------------------------------------------------------------------
#include "scaleFElib.h"
module scale_file_restart_meshfield
  !-----------------------------------------------------------------------------
  !
  !++ Used modules
  !
  use scale_precision
  use scale_io
  use scale_prc, only: &
    prc_myrank, &
    prc_abort
  use scale_file_h, only: &
     file_file_max
  use scale_file_common_meshfield, only: &
    file_common_meshfield_diminfo
  
  use scale_element_base, only: elementbase1d, elementbase2d, elementbase3d
  use scale_mesh_base1d, only: meshbase1d
  use scale_mesh_base2d, only: meshbase2d
  use scale_mesh_base3d, only: meshbase3d
  use scale_mesh_rectdom2d, only: meshrectdom2d
  use scale_mesh_cubedspheredom2d, only: meshcubedspheredom2d
  use scale_mesh_cubedom3d, only: meshcubedom3d
  use scale_mesh_cubedspheredom3d, only: meshcubedspheredom3d
  use scale_localmesh_1d, only: localmesh1d
  use scale_localmesh_2d, only: localmesh2d
  use scale_localmesh_3d, only: localmesh3d
 
  use scale_meshfield_base, only: meshfieldbase, meshfield1d, meshfield2d, meshfield3d
  use scale_variableinfo, only: variableinfo
 
  use scale_file_base_meshfield, only: &
    file_base_meshfield
 
  use scale_mesh_base1d, only: &
    mf1d_dimtype_x => meshbase1d_dimtypeid_x, &
    mf1d_dtype_num => meshbase1d_dimtype_num 
  use scale_mesh_base2d, only: &
    mf2d_dimtype_x => meshbase2d_dimtypeid_x, &
    mf2d_dimtype_y => meshbase2d_dimtypeid_y, &
    mf2d_dtype_num => meshbase2d_dimtype_num 
  use scale_mesh_base3d, only: &
    mf3d_dimtype_x => meshbase3d_dimtypeid_x, &
    mf3d_dimtype_y => meshbase3d_dimtypeid_y, &
    mf3d_dimtype_z => meshbase3d_dimtypeid_z, &
    mf3d_dtype_num => meshbase3d_dimtype_num    
  
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public type & procedures
  !
 
  !> Base derived type to manage restart file with each component
  type :: file_restart_meshfield
    type(FILE_base_meshfield), pointer :: file_ptr => null() !< Pointer to the file object for managing restart file with each component
    logical :: is_file_ptr_main                              !< Flag whether the file_ptr is the main file object
 
    logical :: flag_output                 !< Flag whether output restart file
    character(len=H_LONG) :: in_basename   !< Basename of the input file
    logical :: in_postfix_timelabel        !< Flag whether timelabel is added to the basename of input file
 
    character(len=H_LONG) :: out_basename  !< Basename of the output file
    logical :: out_postfix_timelabel       !< Flag whether timelabel is added to the basename of output file
    character(len=H_MID) :: out_title      !< Title of the output file
    character(len=H_SHORT) :: out_dtype    !< Output data type (DEFAULT, REAL4 or REAL8)
  contains
    procedure, private :: Set_information => file_restart_meshfield_component_set_information
  end type file_restart_meshfield
  type(file_restart_meshfield), public :: restart_file    !< An object to manage main restart file
 
  !> Derived type to manage restart file with each component
  type, extends(file_restart_meshfield), public :: file_restart_meshfield_component
    integer :: registered_comp_id        !< ID of the component registered for restart file
  contains
    procedure :: init1 => file_restart_meshfield_component_init1
    procedure :: init2 => file_restart_meshfield_component_init2
    generic :: init => init1, init2
    procedure :: open => file_restart_meshfield_component_open    
    procedure :: file_restart_meshfield_component_create
    generic :: create => file_restart_meshfield_component_create
    procedure :: file_restart_meshfield_component_def_var
    generic :: def_var => file_restart_meshfield_component_def_var
    procedure :: end_def => file_restart_meshfield_component_enddef
    procedure :: file_restart_meshfield_component_write_var2d
    procedure :: file_restart_meshfield_component_write_var3d
    generic :: write_var => &
      file_restart_meshfield_component_write_var2d, &
      file_restart_meshfield_component_write_var3d
    procedure :: close => file_restart_meshfield_component_close
    procedure :: file_restart_meshfield_component_read_var2d
    procedure :: file_restart_meshfield_component_read_var3d
    generic :: read_var => &
      file_restart_meshfield_component_read_var2d, &
      file_restart_meshfield_component_read_var3d
    procedure :: final => file_restart_meshfield_component_final
  end type
 
  ! Public procedures for main restart file
  public :: file_restart_meshfield_setup
  public :: file_restart_meshfield_finalize
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
 
  !-----------------------------------------------------------------------------
  !
  !++ Private procedures & variables
  !
  type(file_base_meshfield), target :: file_main  !< A file object to manage main restart file
 
  logical :: is_file_main_opened          !< Flag whether the main restart file is opened
  logical :: is_file_main_created         !< Flag whether the main restart file is created
  logical :: is_file_main_enddef          !< Flag whether the main restart file is in enddef mode
  logical :: is_file_main_closed          !< Flag whether the main restart file is closed
 
contains
 
!----------------
  !> Setup the main restart file
!OCL SERIAL
  subroutine file_restart_meshfield_setup()
    implicit none
 
    logical :: output_flag                         = .false.   !< Flag whether output restart file
    character(len=H_LONG) :: in_basename           = ''        !< Basename of the input  file
    logical :: in_postfix_timelabel                = .false.   !< Flag whether timelabel is added to the basename of input  file
    character(len=H_LONG) :: out_basename          = ''        !< Basename of the output file
    logical :: out_postfix_timelabel               = .true.    !< Flag whether timelabel is added to the basename of output file
    character(len=H_MID) :: out_title              = ''        !< Title of the output file
    character(len=H_SHORT) :: out_dtype            = 'DEFAULT' !< Output data type (DEFAULT, REAL4 or REAL8)
 
    namelist / param_restart / &
      output_flag,           &
      in_basename,           &
      in_postfix_timelabel,  &
      out_basename,          &
      out_postfix_timelabel, &
      out_title,             &
      out_dtype
 
    integer :: ierr  
    !----------------------------------------
 
    log_newline
 
    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_restart,iostat=ierr)
    if( ierr < 0 ) then !--- missing
      log_info("FILE_restart_meshfield_setup",*) 'Not found namelist. Default used.'
    elseif( ierr > 0 ) then !--- fatal error
      log_error("FILE_restart_meshfield_setup",*) 'Not appropriate names in namelist PARAM_RESTART. Check!'
      call prc_abort
    endif
    log_nml(param_restart)
 
    ! Setup the information of the main restart file
 
    call restart_file%Set_information( in_basename, in_postfix_timelabel, &
      out_basename, out_postfix_timelabel, out_dtype, out_title           )
 
    restart_file%flag_output = output_flag
 
    restart_file%file_ptr => null() ! Initialize the pointer to null
    is_file_main_opened  = .false.
    is_file_main_created = .false.
    is_file_main_enddef  = .false.
    is_file_main_closed  = .false.
 
    return
  end subroutine file_restart_meshfield_setup
 
  !> Finalize the main restart file
!OCL SERIAL
  subroutine file_restart_meshfield_finalize()
    implicit none
    !--------------------------------------------------
    if ( associated(restart_file%file_ptr) ) then
      call restart_file%file_ptr%Final()
      nullify( restart_file%file_ptr )
    end if
    return
  end subroutine file_restart_meshfield_finalize
 
  !> Initialize an object to manage restart file with each component, and register the component to the main restart file
!OCL SERIAL
  subroutine file_restart_meshfield_component_init1( this, &
    comp_name, var_num, dim_name_postfix,                  &
    mesh1D, mesh2D, meshCubedSphere2D,                     &
    mesh3D, meshCubedSphere3D                              )
 
    use scale_file_common_meshfield, only: &
      file_common_meshfield_get_dims  
    implicit none
 
    class(file_restart_meshfield_component), intent(inout) :: this
    character(*), intent(in) :: comp_name
    integer, intent(in) :: var_num
    character(len=*), optional, intent(in) :: dim_name_postfix
    class(meshbase1d), target, optional, intent(in) :: mesh1d
    class(meshrectdom2d), target, optional, intent(in) :: mesh2d
    class(meshcubedspheredom2d), target, optional, intent(in) :: meshcubedsphere2d
    class(meshcubedom3d), target, optional, intent(in) :: mesh3d
    class(meshcubedspheredom3d), target, optional, intent(in) :: meshcubedsphere3d
 
    character(len=H_SHORT) :: dim_name_postfix_
    !--------------------------------------------------
 
    ! Setup an object to manage restart file with each component, and register the component to the main restart file
 
    if (present(dim_name_postfix)) then
      dim_name_postfix_ = trim(dim_name_postfix)
    else
      dim_name_postfix_ = ""
    end if
    
    if ( .not. associated(restart_file%file_ptr) ) then
      ! Initialize the main restart file
      call file_main%Init( var_num, comp_name, dim_name_postfix_,    &
        mesh1d, mesh2d, meshcubedsphere2d, mesh3d, meshcubedsphere3d )
        
      restart_file%file_ptr => file_main
      ! The first registered component is the main component, and its ID is 1
      this%registered_comp_id = 1
    else
      ! Register the subsequent component to the main restart file
      call file_main%Register_comp( this%registered_comp_id,         & ! (out)
        comp_name, var_num, dim_name_postfix_,                       & ! (in)
        mesh1d, mesh2d, meshcubedsphere2d, mesh3d, meshcubedsphere3d ) ! (in)
    end if
 
    this%file_ptr => file_main
    this%is_file_ptr_main = .true.
    
    ! Setup the information of the component restart file based on the main restart file
    call this%Set_information( &
      restart_file%in_basename, restart_file%in_postfix_timelabel,   &
      restart_file%out_basename, restart_file%out_postfix_timelabel, &
      restart_file%out_dtype, restart_file%out_title                 )
 
    return
  end subroutine file_restart_meshfield_component_init1
 
  !> Initialize an object to manage restart file with each component. 
  !! Restart data for this component are individually outputted to a separate file, not to the main restart file.
  !!
!OCL SERIAL
  subroutine file_restart_meshfield_component_init2( this,  &
      comp_name,                                            &
      in_basename, in_postfix_timelabel,                    &
      out_basename, out_postfix_timelabel,                  &
      out_dtype, out_title,                                 &
      var_num, dim_name_postfix,                            &
      mesh1D,                                               &
      mesh2D, meshCubedSphere2D,                            &
      mesh3D, meshCubedSphere3D                             )
 
    implicit none
 
    class(file_restart_meshfield_component), intent(inout) :: this
    character(*), intent(in) :: comp_name
    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
    character(len=*), intent(in) :: dim_name_postfix
    class(meshbase1d), target, optional, intent(in) :: mesh1d
    class(meshrectdom2d), target, optional, intent(in) :: mesh2d
    class(meshcubedspheredom2d), target, optional, intent(in) :: meshcubedsphere2d
    class(meshcubedom3d), target, optional, intent(in) :: mesh3d
    class(meshcubedspheredom3d), target, optional, intent(in) :: meshcubedsphere3d
    !--------------------------------------------------
 
    call this%Set_information( in_basename, in_postfix_timelabel, &
      out_basename, out_postfix_timelabel, out_dtype, out_title  )
    
    if ( .not. associated(this%file_ptr) ) then
      ! In this case, restart data for this component is individually outputted to a separate file, not to the main restart file. 
      ! Therefore, a new file object is created for this component.
      allocate( this%file_ptr )
      call this%file_ptr%Init( var_num, comp_name, dim_name_postfix, &
        mesh1d, mesh2d, meshcubedsphere2d, mesh3d, meshcubedsphere3d )
      
      this%registered_comp_id = 1
      this%is_file_ptr_main = .false.
    else
      log_info("FILE_restart_meshfield_component_Init2",*) 'File object for this component is already associated, which is unexpected. Check!'
      call prc_abort
    end if
 
    return
  end subroutine file_restart_meshfield_component_init2
 
  !> Open a restart file
!OCL SERIAL
  subroutine file_restart_meshfield_component_open( &
    this )
 
    use scale_time, only: &
      time_gettimelabel    
    implicit none
 
    class(file_restart_meshfield_component), intent(inout) :: this
 
    character(len=19)     :: timelabel
    character(len=H_LONG) :: basename  
    !--------------------------------------------------------------
 
    if ( this%in_basename == '' ) then
      log_info("FILE_restart_meshfield_component_open",*) 'Restart file is not specified. Check!'
      call prc_abort
      return
    end if
 
    if ( this%is_file_ptr_main ) then
      if ( is_file_main_opened ) then
        log_info("FILE_restart_meshfield_component_open",*) 'Main restart file is already opened. Skipping opening.'
      else
        is_file_main_opened = .true.
      end if
    end if
 
    !--------------------------------
 
    if ( this%in_postfix_timelabel ) then
      call time_gettimelabel( timelabel )
      basename = trim(this%in_basename)//'_'//trim(timelabel)
    else
      basename = trim(this%in_basename)
    endif
 
    !--------------------------------
 
    log_newline
    log_info("FILE_restart_meshfield_component_open",*) 'Open restart file'
    call this%file_ptr%open( basename, myrank=prc_myrank )
 
    return
  end subroutine file_restart_meshfield_component_open
 
  !> Create a restart file
!OCL SERIAL
  subroutine file_restart_meshfield_component_create( &
      this )
 
    use scale_time, only: &
      time_gettimelabel,         &
      nowdate   => time_nowdate, &
      nowsubsec => time_nowsubsec
    implicit none
 
    class(file_restart_meshfield_component), intent(inout) :: this
 
    character(len=19)     :: timelabel
    character(len=H_LONG) :: basename  
    character(len=34) :: tunits
    character(len=H_SHORT) :: calendar
    logical :: fileexisted
    !--------------------------------------------------------------
 
    if ( this%out_basename == '' ) return
 
    if ( this%is_file_ptr_main ) then
      if ( is_file_main_created ) then
        log_info("FILE_restart_meshfield_component_create",*) 'Main restart file is already created. Skipping creation.'
      else
        is_file_main_created = .true.
      end if
    end if
 
    !--------------------------------
 
    log_newline
    log_info("FILE_restart_meshfield_component_create",*) 'Create restart file'
 
    if ( this%out_postfix_timelabel ) then
        call time_gettimelabel( timelabel )
        basename = trim(this%out_basename)//'_'//trim(timelabel)
    else
        basename = trim(this%out_basename)
    endif
 
    log_info("FILE_restart_meshfield_component_create",*) 'basename: ', trim(basename)
 
    
    call this%file_ptr%Create( basename, this%out_title, this%out_dtype,       & ! (in)
                           fileexisted,                                        & ! (out)
                           myrank=prc_myrank, tunits=tunits, calendar=calendar ) ! (in)
    
    if ( .not. fileexisted ) then
      call this%file_ptr%Put_GlobalAttribute_time( nowdate, nowsubsec )
    end if
 
    return
  end subroutine file_restart_meshfield_component_create
 
  !> Define a variable in the restart file
!OCL SERIAL
  subroutine file_restart_meshfield_component_def_var( this,      &
    field, desc, vid, dim_type_id                                 )
    implicit none
  
    class(file_restart_meshfield_component), intent(inout) :: this
    class(meshfieldbase), intent(in) :: field
    character(len=*), intent(in) :: desc
    integer, intent(in) :: vid
    integer, intent(in) :: dim_type_id
    !------------------------------------------------------------------
 
    call this%file_ptr%Def_var( &
      field, desc, vid, dim_type_id, this%out_dtype, &
      comp_id=this%registered_comp_id                )   
     
    return 
  end subroutine file_restart_meshfield_component_def_var
 
  !> Finalize the definition of variables in the restart file
!OCL SERIAL
  subroutine file_restart_meshfield_component_enddef( this )
    implicit none
    class(file_restart_meshfield_component), intent(inout) :: this
    !--------------------------------------------------------------
 
    if ( this%is_file_ptr_main ) then
      if ( is_file_main_enddef ) then
        log_info("FILE_restart_meshfield_component_enddef",*) 'Main restart file is already in enddef mode. Skipping enddef.'
      else
        is_file_main_enddef = .true.
      end if
    end if
      
    call this%file_ptr%End_def()
    return
  end subroutine file_restart_meshfield_component_enddef
 
  !> Write a 2D variable to the restart file
!OCL SERIAL
  subroutine file_restart_meshfield_component_write_var2d( this, &
    vid, field2d )
    
    use scale_time, only: time_nowdaysec
    implicit none
 
    class(file_restart_meshfield_component), intent(inout) :: this
    integer, intent(in) :: vid
    class(meshfield2d), intent(in) :: field2d
    !--------------------------------------------------
 
    call this%file_ptr%Write_var2D( vid, field2d, time_nowdaysec, time_nowdaysec, &
      comp_id=this%registered_comp_id )
    
    return
  end subroutine file_restart_meshfield_component_write_var2d
 
  !> Write a 3D variable to the restart file
!OCL SERIAL
  subroutine file_restart_meshfield_component_write_var3d( this, &
    vid, field3d )
    
    use scale_time, only: time_nowdaysec
    implicit none
 
    class(file_restart_meshfield_component), intent(inout) :: this
    integer, intent(in) :: vid
    class(meshfield3d), intent(in) :: field3d
    !--------------------------------------------------
 
    call this%file_ptr%Write_var3D( vid, field3d, time_nowdaysec, time_nowdaysec, &
      comp_id=this%registered_comp_id )
 
    return
  end subroutine file_restart_meshfield_component_write_var3d
 
  !> Read a 2D variable from the restart file
!OCL SERIAL
  subroutine file_restart_meshfield_component_read_var2d( this,  &
    dim_typeid, varname, field2d, step, allow_missing  )
  
  
    implicit none
  
    class(file_restart_meshfield_component), intent(inout) :: this
    integer, intent(in) :: dim_typeid
    character(*), intent(in) :: varname
    class(meshfield2d), intent(inout) :: field2d
    integer, intent(in), optional :: step
    logical, intent(in), optional :: allow_missing
    !------------------------------------------------------
 
    call this%file_ptr%Read_Var( &
          dim_typeid, varname, field2d, step, allow_missing, &
          comp_id=this%registered_comp_id                    )
    
    return
  end subroutine file_restart_meshfield_component_read_var2d
 
  !> Read a 3D variable from the restart file
!OCL SERIAL
  subroutine file_restart_meshfield_component_read_var3d( this,  &
    dim_typeid, varname, field3d, step, allow_missing  )
  
  
    implicit none
  
    class(file_restart_meshfield_component), intent(inout) :: this
    integer, intent(in) :: dim_typeid
    character(*), intent(in) :: varname
    class(meshfield3d), intent(inout) :: field3d
    integer, intent(in), optional :: step
    logical, intent(in), optional :: allow_missing
    !------------------------------------------------------
 
    call this%file_ptr%Read_Var( &
          dim_typeid, varname, field3d, step, allow_missing, &
          comp_id=this%registered_comp_id                    )
    
    return
  end subroutine file_restart_meshfield_component_read_var3d
 
  !> Close a restart file
!OCL SERIAL
  subroutine file_restart_meshfield_component_close( this )
    implicit none
 
    class(file_restart_meshfield_component), intent(inout) :: this
    !--------------------------------------------------
 
    if ( this%is_file_ptr_main ) then
      if ( is_file_main_closed ) then
        log_info("FILE_restart_meshfield_component_close",*) 'Main restart file is already closed. Skipping closure.'
      else
        is_file_main_closed = .true.
      end if
    end if
        
    if ( this%file_ptr%fid /= -1 ) then
      log_newline
      log_info("FILE_restart_meshfield_component_close",*) 'Close restart file'
      call this%file_ptr%Close()
    end if
 
    return
  end subroutine file_restart_meshfield_component_close
 
  !> Finalize an object to manage restart file with each component
!OCL SERIAL
  subroutine file_restart_meshfield_component_final( this )
    implicit none
    class(file_restart_meshfield_component), intent(inout) :: this
    !--------------------------------------------------
 
    ! Release the file object for managing restart file with each component
 
    if ( .not. this%is_file_ptr_main ) then
      call this%file_ptr%Final()
      deallocate( this%file_ptr )
    end if
 
    nullify( this%file_ptr )
    return
  end subroutine file_restart_meshfield_component_final
 
  !- Private -----------
 
  !> Set the information of an object to manage restart file with each component
!OCL SERIAL
  subroutine file_restart_meshfield_component_set_information( this,  &
      in_basename, in_postfix_timelabel,                    &
      out_basename, out_postfix_timelabel,                  &
      out_dtype, out_title                                  )
    implicit none
 
    class(file_restart_meshfield), intent(inout) :: this
    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
    !--------------------------------------------------
 
    this%in_basename = in_basename
    this%in_postfix_timelabel = in_postfix_timelabel
 
    this%out_basename = out_basename
    this%out_postfix_timelabel = out_postfix_timelabel
    this%out_title = out_title
    this%out_dtype = out_dtype
    return
  end subroutine file_restart_meshfield_component_set_information
 
end module scale_file_restart_meshfield