scale_file_base_meshfield.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scaleFElib.h"
module scale_file_base_meshfield
  !-----------------------------------------------------------------------------
  !
  !++ Used modules
  !
  use scale_precision
  use scale_io
  use scale_file_h
  use scale_prc, only: &
    prc_abort
  use scale_file_h, only: &
    file_file_max
  
  use scale_file_common_meshfield, only: &
    file_common_meshfield_diminfo,               &
    get_dtype => file_common_meshfield_get_dtype
  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
 
  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
  
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public type & procedures
  !
    
  type, public :: file_base_meshfield
    integer :: fid
    integer, allocatable :: vars_ncid(:)
 
    integer :: write_buf_amount
    logical :: file_axes_written
 
    class(meshbase1d), pointer :: mesh1d
    class(meshrectdom2d), pointer :: mesh2d
    class(meshcubedspheredom2d), pointer :: meshcs2d
    class(meshcubedom3d), pointer :: mesh3d  
    class(meshcubedspheredom3d), pointer :: meshcs3d
    type(file_common_meshfield_diminfo), allocatable :: dimsinfo(:)
 
    logical :: force_uniform_grid
  contains
    procedure :: init => file_base_meshfield_init
    procedure :: open => file_base_meshfield_open
    procedure :: create => file_base_meshfield_create
 
    !-
    procedure :: file_base_meshfield_def_var1
    procedure :: file_base_meshfield_def_var2
    generic :: def_var => file_base_meshfield_def_var1, file_base_meshfield_def_var2
    procedure :: end_def => file_base_meshfield_enddef
    !-
    procedure :: file_base_meshfield_write_var1d
    generic :: write_var1d => file_base_meshfield_write_var1d
    procedure :: file_base_meshfield_write_var2d
    generic :: write_var2d => file_base_meshfield_write_var2d
    procedure :: file_base_meshfield_write_var3d
    generic :: write_var3d => file_base_meshfield_write_var3d
    !-
    procedure :: put_globalattribute_time => file_base_meshfield_put_global_attribute_time
    !-
    procedure :: file_base_meshfield_read_var1d
    procedure :: file_base_meshfield_read_var1d_local
    procedure :: file_base_meshfield_read_var2d
    procedure :: file_base_meshfield_read_var2d_local
    procedure :: file_base_meshfield_read_var3d
    procedure :: file_base_meshfield_read_var3d_local
    generic :: read_var => &
      file_base_meshfield_read_var1d, file_base_meshfield_read_var1d_local, &
      file_base_meshfield_read_var2d, file_base_meshfield_read_var2d_local, &
      file_base_meshfield_read_var3d, file_base_meshfield_read_var3d_local
    
    !-  
    procedure :: get_commoninfo => file_base_meshfield_get_commoninfo
    procedure :: get_datainfo => file_base_meshfield_get_datainfo
    procedure :: get_varstepsize => file_base_meshfield_get_varstepsize
    !-
    procedure :: close => file_base_meshfield_close
    procedure :: final => file_base_meshfield_final
  end type file_base_meshfield
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedures
  !
  !-------------------
  
  private :: def_axes
  private :: write_axes
  
contains
 
  subroutine file_base_meshfield_init( this, & ! (inout)
    var_num,                                 & ! (in)
    mesh1d,                                  & ! (in)
    mesh2d, meshcubedsphere2d,               & ! (in)
    mesh3d, meshcubedsphere3d,               & ! (in)
    force_uniform_grid )                       ! (in)
 
    use scale_file_common_meshfield, only: &
      file_common_meshfield_get_dims  
 
    implicit none
 
    class(file_base_meshfield), intent(inout) :: this
    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
    logical, intent(in), optional :: force_uniform_grid
 
    logical :: check_specify_mesh
    !--------------------------------------------------
 
    this%fid = -1
 
    allocate( this%vars_ncid(var_num) )
    this%vars_ncid(:) = -1
  
    !-
    check_specify_mesh = .false.
    nullify( this%mesh1D, this%mesh2D, this%mesh3D )
    nullify( this%meshCS2D, this%meshCS3D )
  
    if (present(mesh1d)) then
      this%mesh1D => mesh1d
      check_specify_mesh = .true.
  
      allocate( this%dimsinfo(mf1d_dtype_num) )
      call file_common_meshfield_get_dims( mesh1d, this%dimsinfo(:) )
    end if
    if (present(mesh2d)) then
      this%mesh2D => mesh2d
      check_specify_mesh = .true.
  
      allocate( this%dimsinfo(mf2d_dtype_num) )
      call file_common_meshfield_get_dims( mesh2d, this%dimsinfo(:) )
    end if
    if (present(meshcubedsphere2d)) then
      this%meshCS2D => meshcubedsphere2d
      check_specify_mesh = .true.
  
      allocate( this%dimsinfo(mf2d_dtype_num) )
      call file_common_meshfield_get_dims( meshcubedsphere2d, this%dimsinfo(:) )
    end if
    if (present(mesh3d)) then
      this%mesh3D => mesh3d
      check_specify_mesh = .true.
  
      allocate( this%dimsinfo(mf3d_dtype_num) )
      call file_common_meshfield_get_dims( mesh3d, this%dimsinfo(:) )
    end if
    if (present(meshcubedsphere3d)) then
      this%meshCS3D => meshcubedsphere3d
      check_specify_mesh = .true.
  
      allocate( this%dimsinfo(mf3d_dtype_num) )
      call file_common_meshfield_get_dims( meshcubedsphere3d, this%dimsinfo(:) )
    end if
 
    if ( present(force_uniform_grid) ) then
      this%force_uniform_grid = force_uniform_grid
    else
      this%force_uniform_grid = .false.
    end if
     
    if (.not. check_specify_mesh) then
      log_error("FILE_base_meshfield_Init",*) 'Specify a mesh among mesh1D, 2D, and 3D. Check!'
      call prc_abort
    end if
 
    !-
    this%File_axes_written = .false.
    this%write_buf_amount = 0
  
    return
  end subroutine file_base_meshfield_init
 
  subroutine file_base_meshfield_open( this, & ! (inout)
    basename, myrank                         ) ! (in)
  
    use scale_file, only: &
      file_open 
    implicit none
  
    class(file_base_meshfield), intent(inout) :: this
    character(*), intent(in) :: basename
    integer, intent(in), optional :: myrank
    !--------------------------------------------------------------
    
    call file_open( basename,         & ! [in]
                    this%fid,         & ! [out]
                    rankid=myrank     ) ! [in]
  
    return
  end subroutine file_base_meshfield_open
 
  subroutine file_base_meshfield_create( &
    this, basename, title, dtype,        &
    fileexisted,                         &
    myrank, tunits, calendar )
  
    use scale_file, only: &
      file_create
    implicit none
 
    class(file_base_meshfield), intent(inout) :: this
    character(*), intent(in) :: basename  
    character(*), intent(in) :: title    
    character(*), intent(in) :: dtype
    logical, intent(out) :: fileexisted
    integer, intent(in), optional :: myrank
    character(*), intent(in), optional :: calendar
    character(*), intent(in), optional :: tunits
    !--------------------------------------------------------------
    
    call file_create( basename,                & ! [IN]
                      title,                   & ! [IN]
                      h_source,                & ! [IN]
                      h_institute,             & ! [IN]
                      this%fid,                & ! [OUT]
                      fileexisted,             & ! [OUT]
                      rankid     = myrank,     & ! [IN]
                      time_units = tunits,     & ! [IN]
                      calendar   = calendar    ) ! [IN]
    
    if ( .not. fileexisted ) then
      call def_axes( this, dtype )
      this%File_axes_written = .false.      
    end if
 
    return
  end subroutine file_base_meshfield_create
 
  subroutine file_base_meshfield_def_var1( this, & ! (inout)
    field, desc, vid, dim_type_id, datatype,     & ! (in)
    standard_name, timeinv, nsteps               ) ! (in)
    implicit none
  
    class(file_base_meshfield), intent(inout) :: this
    class(meshfieldbase), intent(in) :: field
    character(len=*), intent(in) :: desc
    integer, intent(in) :: dim_type_id
    integer, intent(in) :: vid
    character(len=*), intent(in) :: datatype
    character(len=*), optional, intent(in) :: standard_name
    real(DP), optional, intent(in) :: timeinv
    integer, optional, intent(in) :: nsteps
    !--------------------------------------------------------------
 
    call this%Def_Var( field%varname, field%unit, &
      desc, vid, dim_type_id, datatype, standard_name, timeinv, nsteps )
  
    return
  end subroutine file_base_meshfield_def_var1  
 
  subroutine file_base_meshfield_def_var2( this,      & ! (inout)
    varname, units, desc, vid, dim_type_id, datatype, & ! (in)
    standard_name, timeinv, nsteps                    ) ! (in)
  
    use scale_file, only: &
      file_opened, &
      file_def_variable, &
      file_set_attribute  
    implicit none
  
    class(file_base_meshfield), intent(inout) :: this    
    character(len=*), intent(in) :: varname
    character(len=*), intent(in) :: units
    character(len=*), intent(in) :: desc
    integer, intent(in) :: dim_type_id
    integer, intent(in) :: vid
    character(len=*), intent(in) :: datatype
    character(len=*), optional, intent(in) :: standard_name
    real(DP), optional, intent(in) :: timeinv
    integer, optional, intent(in) :: nsteps
  
    integer :: i_dtype
    integer :: ndim
    character(len=H_MID)   :: standard_name_  
    !--------------------------------------------------------------
  
    i_dtype = get_dtype(datatype)
  
    if ( present(nsteps) ) then
      this%write_buf_amount = this%write_buf_amount + this%dimsinfo(dim_type_id)%size * nsteps
    else
      this%write_buf_amount = this%write_buf_amount + this%dimsinfo(dim_type_id)%size
    end if
    if ( present(standard_name) ) then
      standard_name_ = standard_name
    else
      standard_name_ = ""
    end if
  
    ndim = this%dimsinfo(dim_type_id)%ndim
    if ( present(timeinv) ) then
      call file_def_variable( this%fid, varname, desc, units, standard_name_,            &
        ndim, this%dimsinfo(dim_type_id)%dims(1:ndim), i_dtype, this%vars_ncid(vid),     &
        time_int=timeinv )
    else
      call file_def_variable( this%fid, varname, desc, units, standard_name_,            &
        ndim, this%dimsinfo(dim_type_id)%dims(1:ndim), i_dtype, this%vars_ncid(vid)      )    
    end if
  
    return
  end subroutine file_base_meshfield_def_var2  
 
  subroutine file_base_meshfield_enddef( this ) ! (inout)
 
    use scale_file, only: &
      file_opened,    &
      file_enddef
    implicit none
    class(file_base_meshfield), intent(inout) :: this
  
    integer :: start(3)
    !--------------------------------------------------------------
  
    if (this%fid == -1) return
  
    call file_enddef( this%fid )
    
    if ( .not. this%File_axes_written ) then
      start(:) = 1
      call write_axes( this, start(:) )
      this%File_axes_written = .true.
    end if
  
    return
  end subroutine file_base_meshfield_enddef
  
!OCL_SERIAL
  subroutine file_base_meshfield_write_var1d( this, & ! (inout)
    vid, field1d, sec_str, sec_end                  ) ! (in)
 
    use scale_file, only: &
        file_opened, &
        file_write 
    use scale_file_common_meshfield, only: &
      file_common_meshfield_put_field1d_cartesbuf
    implicit none
 
    class(file_base_meshfield), intent(inout) :: this
    integer, intent(in) :: vid
    class(meshfield1d), intent(in) :: field1d
    real(DP), intent(in) :: sec_str
    real(DP), intent(in) :: sec_end
    
    real(RP), allocatable :: buf(:)
    integer :: dims(1)
    integer :: start(1)
    !-------------------------------------------------
 
    if ( this%fid /= -1 ) then
      start(:) = 1
      dims(1) = this%dimsinfo(mf1d_dimtype_x)%size
      allocate( buf(dims(1)) )
      call file_common_meshfield_put_field1d_cartesbuf( this%mesh1D, field1d, buf(:), &
        this%force_uniform_grid )
 
      call file_write( this%vars_ncid(vid), buf(:),     & ! (in)
        sec_str, sec_end, start=start                   ) ! (in)
    end if
 
    return
  end subroutine file_base_meshfield_write_var1d
 
!OCL_SERIAL
  subroutine file_base_meshfield_write_var2d( this, & ! (inout)
    vid, field2d, sec_str, sec_end                  ) ! (in)
 
    use scale_file, only: &
        file_opened, &
        file_write 
    use scale_file_common_meshfield, only: &
      file_common_meshfield_put_field2d_cartesbuf,             &
      file_common_meshfield_put_field2d_cubedsphere_cartesbuf
    implicit none
 
    class(file_base_meshfield), intent(inout) :: this
    integer, intent(in) :: vid
    class(meshfield2d), intent(in) :: field2d
    real(DP), intent(in) :: sec_str
    real(DP), intent(in) :: sec_end
    
    real(RP), allocatable :: buf(:,:)
    integer :: dims(2)
    integer :: start(2)
    !-------------------------------------------------
 
    if ( this%fid /= -1 ) then
      start(:) = 1
      dims(1) = this%dimsinfo(mf2d_dimtype_x)%size
      dims(2) = this%dimsinfo(mf2d_dimtype_y)%size
      allocate( buf(dims(1),dims(2)) )
      if ( associated(this%mesh2D) ) then
        call file_common_meshfield_put_field2d_cartesbuf( this%mesh2D, field2d, buf(:,:), &
          this%force_uniform_grid )
      else if ( associated(this%meshCS2D) ) then
        call file_common_meshfield_put_field2d_cubedsphere_cartesbuf( &
          this%meshCS2D, field2d, buf(:,:)                            )
      end if
 
      call file_write( this%vars_ncid(vid), buf(:,:),   & ! (in)
        sec_str, sec_end, start=start                   ) ! (in)
    end if
 
    return
  end subroutine file_base_meshfield_write_var2d
 
!OCL_SERIAL
  subroutine file_base_meshfield_write_var3d( this, & ! (inout)
      vid, field3d, sec_str, sec_end                ) ! (in)
  
    use scale_file, only: &
        file_opened, &
        file_write 
    use scale_file_common_meshfield, only: &
      file_common_meshfield_put_field3d_cartesbuf,            &
      file_common_meshfield_put_field3d_cubedsphere_cartesbuf
    use scale_prof
    implicit none
 
    class(file_base_meshfield), intent(inout) :: this
    integer, intent(in) :: vid
    class(meshfield3d), intent(in) :: field3d
    real(DP), intent(in) :: sec_str
    real(DP), intent(in) :: sec_end
    
    real(RP), allocatable :: buf(:,:,:)
    integer :: dims(3)
    integer :: start(3)
    !-------------------------------------------------
  
    if ( this%fid /= -1 ) then
      start(:) = 1
      dims(1) = this%dimsinfo(mf3d_dimtype_x)%size
      dims(2) = this%dimsinfo(mf3d_dimtype_y)%size
      dims(3) = this%dimsinfo(mf3d_dimtype_z)%size
      allocate( buf(dims(1),dims(2),dims(3)) )
 
      if ( associated(this%mesh3D) ) then
        call file_common_meshfield_put_field3d_cartesbuf( this%mesh3D, field3d, buf(:,:,:), &
          this%force_uniform_grid )
      else if ( associated(this%meshCS3D) ) then
        call file_common_meshfield_put_field3d_cubedsphere_cartesbuf( &
          this%meshCS3D, field3d, buf(:,:,:)                          )
      end if
 
      call file_write( this%vars_ncid(vid), buf(:,:,:),     & ! (in)
        sec_str, sec_end, start                             ) ! (in)
    end if
  
    return
  end subroutine file_base_meshfield_write_var3d
 
  subroutine file_base_meshfield_get_commoninfo( this, & ! (in)
    title, source, institution                         ) ! (out)
    use scale_file, only: &
      file_get_attribute
    implicit none
    
    class(file_base_meshfield), intent(in) :: this
    character(len=FILE_HMID), intent(out), optional :: title
    character(len=FILE_HMID), intent(out), optional :: source
    character(len=FILE_HMID), intent(out), optional :: institution
    !-------------------------------------------------
 
    if ( present(title) ) call file_get_attribute( this%fid, 'global', 'title', title )
    if ( present(source) ) call file_get_attribute( this%fid, 'global', 'source', source )
    if ( present(institution) ) call file_get_attribute( this%fid, 'global', 'institution', institution )
 
    return
  end subroutine file_base_meshfield_get_commoninfo
 
  subroutine file_base_meshfield_get_varstepsize( this, varname, & ! (in)
    len                                                          ) ! (out)
    use scale_file, only: &
      file_get_stepsize    
    implicit none
 
    class(file_base_meshfield), intent(in) :: this
    character(*), intent(in) :: varname
    integer, intent(out) :: len
    !-------------------------------------------------
 
    call file_get_stepsize( this%fid, varname, & ! (in)
      len )                                      ! (out)
    
    return    
  end subroutine file_base_meshfield_get_varstepsize
 
  subroutine file_base_meshfield_get_datainfo( this, varname, istep, & ! (in)
    description, units, standard_name,                               & ! (out)
    time_start, time_end, time_units, calendar                       ) ! (out)
    use scale_file, only: &
      file_get_datainfo
    implicit none
    
    class(file_base_meshfield), intent(in) :: this
    character(*), intent(in) :: varname
    integer, intent(in), optional :: istep
    character(len=FILE_HMID), intent(out), optional :: description
    character(len=FILE_HSHORT), intent(out), optional :: units
    character(len=FILE_HMID), intent(out), optional :: standard_name
    real(DP), intent(out), optional :: time_start
    real(DP), intent(out), optional :: time_end
    character(len=FILE_HMID), intent(out), optional :: time_units
    character(len=FILE_HSHORT), intent(out), optional :: calendar
    !-------------------------------------------------
 
    call file_get_datainfo( this%fid, varname, istep=istep,                               & ! (in)
      description=description, units=units, standard_name=standard_name,                  & ! (out)
      time_start=time_start, time_end=time_end, time_units=time_units, calendar=calendar  ) ! (out)
 
    return
  end subroutine file_base_meshfield_get_datainfo
 
!OCL_SERIAL
  subroutine file_base_meshfield_read_var1d( this,    & ! (inout)
    dim_typeid, varname,                              & ! (in)
    field1d,                                          & ! (inout)
    step, allow_missing )                               ! (in)
  
    use scale_file, only: &
      file_read
    use scale_file_common_meshfield, only: &
      file_common_meshfield_set_cartesbuf_field1d
 
    implicit none
  
    class(file_base_meshfield), intent(inout) :: this
    integer, intent(in) :: dim_typeid
    character(*), intent(in) :: varname
    class(meshfield1d), intent(inout) :: field1d
    integer, intent(in), optional :: step
    logical, intent(in), optional :: allow_missing
  
    real(RP), allocatable :: buf(:)
    integer :: dims(1)
    integer :: start(1)   ! start offset of globale variable
    !-------------------------------------------------
  
    if ( this%fid /= -1 ) then
      start(:) = 1
      dims(1) = this%dimsinfo(dim_typeid)%size
      allocate( buf(dims(1)) )
  
      call file_read( this%fid, varname,                       & ! (in)
        buf(:),                                                & ! (out)
        step=step, allow_missing=allow_missing                 ) ! (in)
  
      call file_common_meshfield_set_cartesbuf_field1d( this%mesh1D, buf(:), &
        field1d )
    end if
  
    return
  end subroutine file_base_meshfield_read_var1d
 
!OCL_SERIAL
  subroutine file_base_meshfield_read_var1d_local( this, & ! (inout)
    dim_typeid, varname, lcmesh, i0_s,                   & ! (in)
    val,                                                 & ! (out)
    step, allow_missing  )                                 ! (in)
  
    use scale_file, only: &
      file_read
    use scale_file_common_meshfield, only: &
      file_common_meshfield_set_cartesbuf_field1d_local
  
    implicit none
  
    class(file_base_meshfield), intent(inout) :: this
    integer, intent(in) :: dim_typeid
    character(*), intent(in) :: varname
    class(localmesh1d), intent(in) :: lcmesh
    integer, intent(in) :: i0_s
    real(RP), intent(out) :: val(lcmesh%refElem1D%Np,lcmesh%NeA)
    integer, intent(in), optional :: step
    logical, intent(in), optional :: allow_missing
  
    real(RP), allocatable :: buf(:)
    integer :: dims(1)
    integer :: start(1)   ! start offset of globale variable
    !-------------------------------------------------
  
    if ( this%fid /= -1 ) then
      start(:) = 1
      dims(1) = this%dimsinfo(dim_typeid)%size
      allocate( buf(dims(1)) )
  
      call file_read( this%fid, varname,                       & ! (in)
        buf(:),                                                & ! (out)
        step=step, allow_missing=allow_missing                 ) ! (in)
  
      call file_common_meshfield_set_cartesbuf_field1d_local( &
        lcmesh, buf(:), i0_s,                                 &
        val(:,:) )
    end if
  
    return
  end subroutine file_base_meshfield_read_var1d_local 
 
!OCL_SERIAL
  subroutine file_base_meshfield_read_var2d( this, & ! (inout)
    dim_typeid, varname,                           & ! (in)
    field2d,                                       & ! (inout)
    step, allow_missing                            ) ! (in)
  
    use scale_file, only: &
      file_read
    use scale_file_common_meshfield, only: &
      file_common_meshfield_set_cartesbuf_field2d,           &
      file_common_meshfield_set_cartesbuf_field2d_cubedsphere
  
    implicit none
  
    class(file_base_meshfield), 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
  
    real(RP), allocatable :: buf(:,:)
    integer :: dims(2)
    integer :: start(2)   ! start offset of globale variable
    !-------------------------------------------------
  
    if ( this%fid /= -1 ) then
      start(:) = 1
      dims(1) = this%dimsinfo(mf2d_dimtype_x)%size
      dims(2) = this%dimsinfo(mf2d_dimtype_y)%size
      allocate( buf(dims(1),dims(2)) )
  
      call file_read( this%fid, varname,                       & ! (in)
        buf(:,:),                                              & ! (out)
        step=step, allow_missing=allow_missing                 ) ! (in)
  
      if ( associated( this%meshCS2D) ) then
        call file_common_meshfield_set_cartesbuf_field2d_cubedsphere( &
          this%meshCS2D, buf(:,:),                                    &
          field2d )
      else if ( associated( this%mesh2D) ) then
        call file_common_meshfield_set_cartesbuf_field2d( this%mesh2D, buf(:,:),   &
          field2d )
      end if
    end if
  
    return
  end subroutine file_base_meshfield_read_var2d
 
!OCL_SERIAL
  subroutine file_base_meshfield_read_var2d_local( this, & ! (inout)
    dim_typeid, varname, lcmesh, i0_s, j0_s,             & ! (in)
    val,                                                 & ! (out)
    step, allow_missing  )                                 ! (in)
  
    use scale_file, only: &
      file_read
    use scale_file_common_meshfield, only: &
      file_common_meshfield_set_cartesbuf_field2d_local
  
    implicit none
  
    class(file_base_meshfield), intent(inout) :: this
    integer, intent(in) :: dim_typeid
    character(*), intent(in) :: varname
    class(localmesh2d), intent(in) :: lcmesh
    integer, intent(in) :: i0_s, j0_s
    real(RP), intent(out) :: val(lcmesh%refElem2D%Np,lcmesh%NeA)
    integer, intent(in), optional :: step
    logical, intent(in), optional :: allow_missing
  
    real(RP), allocatable :: buf(:,:)
    integer :: dims(2)
    integer :: start(2)   ! start offset of globale variable
    !-------------------------------------------------
  
    if ( this%fid /= -1 ) then
      start(:) = 1
      dims(1) = this%dimsinfo(mf2d_dimtype_x)%size
      dims(2) = this%dimsinfo(mf2d_dimtype_y)%size
      allocate( buf(dims(1),dims(2)) )
  
      call file_read( this%fid, varname,                       & ! (in)
        buf(:,:),                                              & ! (out)
        step=step, allow_missing=allow_missing                 ) ! (in)
  
      call file_common_meshfield_set_cartesbuf_field2d_local( &
        lcmesh, buf(:,:), i0_s, j0_s,                         &
        val(:,:) )
    end if
  
    return
  end subroutine file_base_meshfield_read_var2d_local
 
!OCL_SERIAL
  subroutine file_base_meshfield_read_var3d( this, & ! (inout)
    dim_typeid, varname,                           & ! (in)
    field3d,                                       & ! (inout)
    step, allow_missing                            ) ! (in)
  
    use scale_file, only: &
      file_read
    use scale_file_common_meshfield, only: &
      file_common_meshfield_set_cartesbuf_field3d,            &
      file_common_meshfield_set_cartesbuf_field3d_cubedsphere
 
  
    implicit none
  
    class(file_base_meshfield), 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
  
    real(RP), allocatable :: buf(:,:,:)
    integer :: dims(3)
    integer :: start(3)   ! start offset of globale variable
    !-------------------------------------------------
  
    if ( this%fid /= -1 ) then
      start(:) = 1
      dims(1) = this%dimsinfo(mf3d_dimtype_x)%size
      dims(2) = this%dimsinfo(mf3d_dimtype_y)%size
      dims(3) = this%dimsinfo(mf3d_dimtype_z)%size
      allocate( buf(dims(1),dims(2),dims(3)) )
  
      call file_read( this%fid, varname,                       & ! (in)
        buf(:,:,:),                                            & ! (out)
        step=step, allow_missing=allow_missing                 ) ! (in)
  
      if ( associated(this%meshCS3D) ) then
        call file_common_meshfield_set_cartesbuf_field3d_cubedsphere( &
          this%meshCS3D, buf(:,:,:),                                  &
          field3d )
      else if ( associated(this%mesh3D) ) then
        call file_common_meshfield_set_cartesbuf_field3d( this%mesh3D, buf(:,:,:), &
          field3d )
      end if
    end if
  
    return
  end subroutine file_base_meshfield_read_var3d
 
!OCL_SERIAL
  subroutine file_base_meshfield_read_var3d_local( this, & ! (inout)
    dim_typeid, varname, lcmesh, i0_s, j0_s, k0_s,       & ! (in)
    val,                                                 & ! (out)
    step, allow_missing  )                                 ! (in)
  
    use scale_file, only: &
      file_read
    use scale_file_common_meshfield, only: &
      file_common_meshfield_set_cartesbuf_field3d_local
  
    implicit none
  
    class(file_base_meshfield), intent(inout) :: this
    integer, intent(in) :: dim_typeid
    character(*), intent(in) :: varname
    class(localmesh3d), intent(in) :: lcmesh
    integer, intent(in) :: i0_s, j0_s, k0_s
    real(RP), intent(out) :: val(lcmesh%refElem3D%Np,lcmesh%NeA)
    integer, intent(in), optional :: step
    logical, intent(in), optional :: allow_missing
  
    real(RP), allocatable :: buf(:,:,:)
    integer :: dims(3)
    integer :: start(3)   ! start offset of globale variable
    !-------------------------------------------------
  
    if ( this%fid /= -1 ) then
      start(:) = 1
      dims(1) = this%dimsinfo(mf3d_dimtype_x)%size
      dims(2) = this%dimsinfo(mf3d_dimtype_y)%size
      dims(3) = this%dimsinfo(mf3d_dimtype_z)%size
      allocate( buf(dims(1),dims(2),dims(3)) )
  
      call file_read( this%fid, varname,                       & ! (in)
        buf(:,:,:),                                            & ! (out)
        step=step, allow_missing=allow_missing                 ) ! (in)
  
      call file_common_meshfield_set_cartesbuf_field3d_local( &
        lcmesh, buf(:,:,:), i0_s, j0_s, k0_s,                 &
        val(:,:) )
    end if
  
    return
  end subroutine file_base_meshfield_read_var3d_local
 
  subroutine file_base_meshfield_close( this ) ! (inout)
    use scale_file, only: file_close
    
    implicit none
    class(file_base_meshfield), intent(inout) :: this
    !--------------------------------------------------
  
    if ( this%fid /= -1 ) then
      call file_close( this%fid ) ! [IN]
      this%fid = -1
    end if
  
    return
  end subroutine file_base_meshfield_close
 
  
  subroutine file_base_meshfield_final( this ) ! (inout)
    implicit none
    class(file_base_meshfield), intent(inout) :: this
    !--------------------------------------------------
  
    if ( allocated(this%vars_ncid) ) deallocate( this%vars_ncid )
    if ( allocated(this%dimsinfo) ) deallocate( this%dimsinfo )
    nullify( this%mesh1D, this%mesh2D, this%mesh3D )
  
    return
  end subroutine file_base_meshfield_final
 
  subroutine file_base_meshfield_put_global_attribute_time( &
    this, date, subsec  )
 
    use scale_file, only: &
      file_set_attribute, &
      file_get_cftunits
    use scale_calendar, only: &
      calendar_get_name
       
    implicit none
 
    class(file_base_meshfield), intent(inout) :: this 
    integer, intent(in) :: date(6)
    real(DP), intent(in) :: subsec
 
    character(34) :: tunits
    character(len=H_SHORT) :: calendar_name
    !------------------------------------
 
    call file_set_attribute( this%fid, "global", "Conventions", "CF-1.6" ) ! [IN]
    call file_set_attribute( this%fid, "global", "grid_name", "hoge"     ) ! [IN]
 
    !- time
 
    if ( date(1) > 0 ) then
      call file_get_cftunits( date(:), tunits )
      call calendar_get_name( calendar_name )
    else
      tunits        = 'seconds'
      calendar_name = ''
    endif
        
    if ( calendar_name /= "" ) &
      call file_set_attribute( this%fid, "global", "calendar", calendar_name )
    call file_set_attribute( this%fid, "global", "time_units", tunits )
    call file_set_attribute( this%fid, "global", "time_start", (/ subsec /) )
 
    return
  end subroutine file_base_meshfield_put_global_attribute_time
 
  !- private -----------------------------------------
 
  subroutine def_axes( this, & ! (in)
    dtype                    ) ! (in)
    use scale_const, only: &
      undef => const_undef
    use scale_file, only: &
      file_def_axis,                 &
      file_set_attribute,            &
      file_def_associatedcoordinate, &
      file_add_associatedvariable
 
    implicit none
 
    class(file_base_meshfield), intent(in) :: this
    character(*), intent(in) :: dtype
    integer :: d
    integer :: i_dtype
    !------------
 
    i_dtype = get_dtype( dtype )
 
    if ( associated(this%mesh1D) ) then
      do d=1, 1
        call file_def_axis( this%fid, &
          this%dimsinfo(d)%name, this%dimsinfo(d)%desc, this%dimsinfo(d)%unit, &
          this%dimsinfo(d)%name, i_dtype, this%dimsinfo(d)%size                )
      end do
    end if
 
    if (      associated(this%mesh2D)   &
         .or. associated(this%meshCS2D) ) then
      do d=1, 2
        call file_def_axis( this%fid, &
          this%dimsinfo(d)%name, this%dimsinfo(d)%desc, this%dimsinfo(d)%unit, &
          this%dimsinfo(d)%name, i_dtype, this%dimsinfo(d)%size                )
      end do
    end if
 
    if (      associated(this%mesh3D)   &
         .or. associated(this%meshCS3D) ) then
      do d=1, 3
        call file_def_axis( this%fid, &
          this%dimsinfo(d)%name, this%dimsinfo(d)%desc, this%dimsinfo(d)%unit, &
          this%dimsinfo(d)%name, i_dtype, this%dimsinfo(d)%size                )
      end do
    end if
 
    return
  end subroutine def_axes
 
  subroutine write_axes( this, & ! (in)
    start                      ) ! (in)
    use scale_const, only: &
      undef => const_undef
    use scale_file, only: &
      file_write_axis, &
      file_set_attribute
    use scale_file_common_meshfield, only: &
      file_common_meshfield_get_axis
    implicit none
 
    class(file_base_meshfield), intent(in) :: this
    integer, intent(in) :: start(3)
 
    real(RP), allocatable :: x(:)
    real(RP), allocatable :: y(:)
    real(RP), allocatable :: z(:)
    !------------
 
    if ( associated(this%mesh1D) ) then
      allocate( x(this%dimsinfo(1)%size) )
      call file_common_meshfield_get_axis( this%mesh1D, this%dimsinfo, x(:), this%force_uniform_grid )
 
      call file_write_axis( this%fid, this%dimsinfo(1)%name, x(:), start(1:1) )
    end if
 
    if ( associated(this%mesh2D)  ) then
      allocate( x(this%dimsinfo(1)%size), y(this%dimsinfo(2)%size) )
      call file_common_meshfield_get_axis( this%mesh2D, this%dimsinfo, x(:), y(:), this%force_uniform_grid )
 
      call file_write_axis( this%fid, this%dimsinfo(1)%name, x(:), start(1:1) )
      call file_write_axis( this%fid, this%dimsinfo(2)%name, y(:), start(2:2) )
    end if
 
    if ( associated(this%meshCS2D)  ) then
      allocate( x(this%dimsinfo(1)%size), y(this%dimsinfo(2)%size) )
      call file_common_meshfield_get_axis( this%meshCS2D, this%dimsinfo, x(:), y(:) )
 
      call file_write_axis( this%fid, this%dimsinfo(1)%name, x(:), start(1:1) )
      call file_write_axis( this%fid, this%dimsinfo(2)%name, y(:), start(2:2) )
    end if
 
    if ( associated(this%mesh3D) ) then
      allocate( x(this%dimsinfo(1)%size), y(this%dimsinfo(2)%size), z(this%dimsinfo(3)%size) )
      call file_common_meshfield_get_axis( this%mesh3D, this%dimsinfo, x(:), y(:), z(:), this%force_uniform_grid )
 
      call file_write_axis( this%fid, this%dimsinfo(1)%name, x(:), start(1:1) )
      call file_write_axis( this%fid, this%dimsinfo(2)%name, y(:), start(2:2) )
      call file_write_axis( this%fid, this%dimsinfo(3)%name, z(:), start(3:3) )
      if ( this%dimsinfo(3)%positive_down(1) ) &
        call file_set_attribute( this%fid, this%dimsinfo(3)%name, "positive", "down" )
    end if  
 
    if ( associated(this%meshCS3D) ) then
      allocate( x(this%dimsinfo(1)%size), y(this%dimsinfo(2)%size), z(this%dimsinfo(3)%size) )
      call file_common_meshfield_get_axis( this%meshCS3D, this%dimsinfo, x(:), y(:), z(:) )
 
      call file_write_axis( this%fid, this%dimsinfo(1)%name, x(:), start(1:1) )
      call file_write_axis( this%fid, this%dimsinfo(2)%name, y(:), start(2:2) )
      call file_write_axis( this%fid, this%dimsinfo(3)%name, z(:), start(3:3) )
      if ( this%dimsinfo(3)%positive_down(1) ) &
        call file_set_attribute( this%fid, this%dimsinfo(3)%name, "positive", "down" )
    end if  
 
    return
  end subroutine write_axes
 
end module scale_file_base_meshfield