scale_file_restart_meshfield.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#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
  !
  type :: file_restart_meshfield
    type(FILE_base_meshfield) :: base
 
    logical :: flag_output
    character(len=H_LONG) :: in_basename
    logical :: in_postfix_timelabel
 
    character(len=H_LONG) :: out_basename
    logical :: out_postfix_timelabel
    character(len=H_MID) :: out_title
    character(len=H_SHORT) :: out_dtype
  end type file_restart_meshfield
  type(file_restart_meshfield), public :: restart_file
 
  public :: file_restart_meshfield_setup
 
 
  type, extends(file_restart_meshfield), public :: file_restart_meshfield_component
    character(len=H_SHORT) :: comp_name
  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 parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedures
  !
  !-------------------
 
contains
 
!----------------
!OCL SERIAL
  subroutine file_restart_meshfield_setup()
    implicit none
 
    logical :: output_flag                         = .false.   
    character(len=H_LONG) :: in_basename           = ''
    logical :: in_postfix_timelabel                = .false.   
    character(len=H_LONG) :: out_basename          = ''
    logical :: out_postfix_timelabel               = .true.    
    character(len=H_MID) :: out_title              = ''
    character(len=H_SHORT) :: out_dtype            = 'DEFAULT'
 
    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)
 
    restart_file%flag_output = output_flag
 
    restart_file%in_basename = in_basename
    restart_file%in_postfix_timelabel = in_postfix_timelabel
    
    restart_file%out_basename = out_basename
    restart_file%out_postfix_timelabel = out_postfix_timelabel
    restart_file%out_title = out_title
    restart_file%out_dtype = out_dtype
 
    restart_file%base%fid = -1
 
    return
  end subroutine file_restart_meshfield_setup
 
!OCL SERIAL
  subroutine file_restart_meshfield_component_init1( this,  &
    comp_name,                                              &
    var_num, 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
    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%Init2( &
      comp_name,                                                            &
      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,                       &
      var_num, mesh1d, mesh2d, meshcubedsphere2d, mesh3d, meshcubedsphere3d )
 
    return
  end subroutine file_restart_meshfield_component_init1
 
!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,                                              &
      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
    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
    !--------------------------------------------------
    this%comp_name = comp_name
 
    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
 
    !-
    call this%base%Init( var_num, mesh1d, mesh2d, meshcubedsphere2d, mesh3d, meshcubedsphere3d )
 
    return
  end subroutine file_restart_meshfield_component_init2
 
!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(trim(this%comp_name)//"_vars_restart_open",*) 'restart file is not specified. Check!'
      call prc_abort
      return
    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(trim(this%comp_name)//"_vars_restart_open",*) 'Open restart file'
    call this%base%open( basename, myrank=prc_myrank )
 
    return
  end subroutine file_restart_meshfield_component_open
 
!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
 
    !--------------------------------
 
    log_newline
    log_info(trim(this%comp_name)//"_vars_restart_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(trim(this%comp_name)//"_vars_restart_create",*) 'basename: ', trim(basename)
 
    
    call this%base%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%base%Put_GlobalAttribute_time( nowdate, nowsubsec )
    end if
 
    return
  end subroutine file_restart_meshfield_component_create
 
!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%base%Def_var( &
      field, desc, vid, dim_type_id, this%out_dtype )   
     
    return 
  end subroutine file_restart_meshfield_component_def_var
 
!OCL SERIAL
  subroutine file_restart_meshfield_component_enddef( this )
 
    implicit none
    class(file_restart_meshfield_component), intent(inout) :: this
    !--------------------------------------------------------------
  
    call this%base%End_def()
    return
  end subroutine file_restart_meshfield_component_enddef
 
!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%base%Write_var2D( vid, field2d, time_nowdaysec, time_nowdaysec )
 
    return
  end subroutine file_restart_meshfield_component_write_var2d
 
!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%base%Write_var3D( vid, field3d, time_nowdaysec, time_nowdaysec )
 
    return
  end subroutine file_restart_meshfield_component_write_var3d
 
!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%base%Read_Var( &
          dim_typeid, varname, field2d, step, allow_missing  )
    
    return
  end subroutine file_restart_meshfield_component_read_var2d
 
!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%base%Read_Var( &
          dim_typeid, varname, field3d, step, allow_missing  )
    
    return
  end subroutine file_restart_meshfield_component_read_var3d
 
!OCL SERIAL
  subroutine file_restart_meshfield_component_close( this )
    implicit none
 
    class(file_restart_meshfield_component), intent(inout) :: this
    !--------------------------------------------------
 
    if ( this%base%fid /= -1 ) then
      log_newline
      log_info(trim(this%comp_name)//"_vars_restart_close",*) 'Close restart file'
      call this%base%Close()
    end if
 
    return
  end subroutine file_restart_meshfield_component_close
 
!OCL SERIAL
  subroutine file_restart_meshfield_component_final( this )
    implicit none
    class(file_restart_meshfield_component), intent(inout) :: this
    !--------------------------------------------------
 
    call this%base%Final()
 
    return
  end subroutine file_restart_meshfield_component_final
 
  !------------
 
end module scale_file_restart_meshfield