TABLE OF CONTENTS


etsf_io_geometry_copy

[ Top ] [ etsf_geometry ] [ Methods ]

NAME

etsf_io_geometry_copy

FUNCTION

This routine copy all variable of a group from one file @ncid_from to another @ncid_to. If a variable is missing in the source file, this does not raise an error, it is simply skipped. But if a variable in the destination file is not defined, this will raise an error.

The copy is done per variable. This means that memory occupation is reduced during the copy.

Normally, copies are pristine copies. But if optional argument @split is given, then the read values are copied to the specified locations in split arrays. In that case, the destination variable must have a compatible definition with the split values.

INPUTS

OUTPUT

NOTES

This file has been automatically generated by the autogen_subroutines.py script. Any change you would bring to it will systematically be overwritten.

SOURCE

subroutine etsf_io_geometry_copy(ncid_to, ncid_from, dims, lstat, error_data, &
  & split)

  !Arguments ------------------------------------
  integer, intent(in) :: ncid_to
  integer, intent(in) :: ncid_from
  type(etsf_dims), intent(in) :: dims
  logical, intent(out) :: lstat
  type(etsf_io_low_error), intent(out) :: error_data
  type(etsf_split), optional, intent(in) :: split

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_geometry_copy'
  type(etsf_split) :: my_split
  integer,allocatable :: varids(:,:)
  integer :: nvarids
  integer,allocatable :: start(:)
  integer,allocatable :: count(:)
  integer :: len
  integer :: istart
  integer :: idim1,idim2,idim3,idim4,idim5,idim6,idim7,idim8
  integer,allocatable :: istop(:)
  integer,allocatable :: jstart(:)
  integer,allocatable :: jend(:)
  type(etsf_geometry) :: folder


  ! *************************************************************************

!DEBUG
!write (*,*) 'etsf_io_geometry_copy : enter'
!ENDDEBUG

  lstat = .false.
  call etsf_io_low_set_write_mode(ncid_to, lstat, error_data = error_data)
  if (.not. lstat) return
  
  allocate(varids(2,11))
  nvarids = 1
  
  ! Variable 'space_group'
  !  allocate and read data
  allocate(folder%space_group)
  call etsf_io_low_read_var(ncid_from, "space_group", &
                          & folder%space_group, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%space_group)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "space_group", &
                             & folder%space_group, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%space_group)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%space_group)
  
  lstat = .true.
  ! Variable 'primitive_vectors'
  !  allocate and read data
  allocate(folder%primitive_vectors( &
    & dims%number_of_vectors, &
    & dims%number_of_cartesian_directions))
  call etsf_io_low_read_var(ncid_from, "primitive_vectors", &
                          & folder%primitive_vectors, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%primitive_vectors)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "primitive_vectors", &
                             & folder%primitive_vectors, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%primitive_vectors)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%primitive_vectors)
  
  lstat = .true.
  ! Variable 'reduced_symmetry_matrices'
  !  allocate and read data
  allocate(folder%reduced_symmetry_matrices( &
    & dims%number_of_symmetry_operations, &
    & dims%number_of_reduced_dimensions, &
    & dims%number_of_reduced_dimensions))
  call etsf_io_low_read_var(ncid_from, "reduced_symmetry_matrices", &
                          & folder%reduced_symmetry_matrices, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%reduced_symmetry_matrices)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "reduced_symmetry_matrices", &
                             & folder%reduced_symmetry_matrices, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%reduced_symmetry_matrices)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%reduced_symmetry_matrices)
  
  lstat = .true.
  ! Variable 'reduced_symmetry_translations'
  !  allocate and read data
  allocate(folder%reduced_symmetry_translations( &
    & dims%number_of_symmetry_operations, &
    & dims%number_of_reduced_dimensions))
  call etsf_io_low_read_var(ncid_from, "reduced_symmetry_translations", &
                          & folder%reduced_symmetry_translations, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%reduced_symmetry_translations)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "reduced_symmetry_translations", &
                             & folder%reduced_symmetry_translations, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%reduced_symmetry_translations)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%reduced_symmetry_translations)
  
  lstat = .true.
  ! Variable 'atom_species'
  !  allocate and read data
  allocate(folder%atom_species( &
    & dims%number_of_atoms))
  call etsf_io_low_read_var(ncid_from, "atom_species", &
                          & folder%atom_species, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%atom_species)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "atom_species", &
                             & folder%atom_species, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%atom_species)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%atom_species)
  
  lstat = .true.
  ! Variable 'reduced_atom_positions'
  !  allocate and read data
  allocate(folder%reduced_atom_positions( &
    & dims%number_of_atoms, &
    & dims%number_of_reduced_dimensions))
  call etsf_io_low_read_var(ncid_from, "reduced_atom_positions", &
                          & folder%reduced_atom_positions, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%reduced_atom_positions)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "reduced_atom_positions", &
                             & folder%reduced_atom_positions, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%reduced_atom_positions)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%reduced_atom_positions)
  
  lstat = .true.
  ! Variable 'valence_charges'
  !  allocate and read data
  allocate(folder%valence_charges( &
    & dims%number_of_atom_species))
  call etsf_io_low_read_var(ncid_from, "valence_charges", &
                          & folder%valence_charges, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%valence_charges)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "valence_charges", &
                             & folder%valence_charges, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%valence_charges)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%valence_charges)
  
  lstat = .true.
  ! Variable 'atomic_numbers'
  !  allocate and read data
  allocate(folder%atomic_numbers( &
    & dims%number_of_atom_species))
  call etsf_io_low_read_var(ncid_from, "atomic_numbers", &
                          & folder%atomic_numbers, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%atomic_numbers)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "atomic_numbers", &
                             & folder%atomic_numbers, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%atomic_numbers)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%atomic_numbers)
  
  lstat = .true.
  ! Variable 'atom_species_names'
  !  allocate and read data
  allocate(folder%atom_species_names( &
    & dims%number_of_atom_species))
  call etsf_io_low_read_var(ncid_from, "atom_species_names", &
                          & folder%atom_species_names, dims%character_string_length, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%atom_species_names)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "atom_species_names", &
                             & folder%atom_species_names, dims%character_string_length, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%atom_species_names)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%atom_species_names)
  
  lstat = .true.
  ! Variable 'chemical_symbols'
  !  allocate and read data
  allocate(folder%chemical_symbols( &
    & dims%number_of_atom_species))
  call etsf_io_low_read_var(ncid_from, "chemical_symbols", &
                          & folder%chemical_symbols, dims%symbol_length, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%chemical_symbols)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "chemical_symbols", &
                             & folder%chemical_symbols, dims%symbol_length, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%chemical_symbols)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%chemical_symbols)
  
  lstat = .true.
  ! Variable 'pseudopotential_types'
  !  allocate and read data
  allocate(folder%pseudopotential_types( &
    & dims%number_of_atom_species))
  call etsf_io_low_read_var(ncid_from, "pseudopotential_types", &
                          & folder%pseudopotential_types, dims%character_string_length, lstat, &
                          & error_data = error_data, ncvarid = varids(1, nvarids))
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%pseudopotential_types)
    deallocate(varids)
    call etsf_io_low_error_update(error_data, my_name)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "pseudopotential_types", &
                             & folder%pseudopotential_types, dims%character_string_length, lstat, &
                             & error_data = error_data, ncvarid = varids(2, nvarids))
    if (.not. lstat) then
      deallocate(folder%pseudopotential_types)
      deallocate(varids)
      call etsf_io_low_error_update(error_data, my_name)
      return
    end if
    nvarids = nvarids + 1
  end if
  deallocate(folder%pseudopotential_types)
  
  lstat = .true.
  
  ! We copy all the attributes (ETSF and non-ETSF) of the group variables.
  call etsf_io_low_set_define_mode(ncid_to, lstat, error_data = error_data)
  if (.not. lstat) nvarids = 0
  do len = 1, nvarids - 1, 1
    call etsf_io_low_copy_all_att(ncid_from, ncid_to, varids(1, len), varids(2, len), &
                                & lstat, error_data = error_data)
    if (.not. lstat) then
      call etsf_io_low_error_update(error_data, my_name)
      exit
    end if
  end do
  deallocate(varids)

!DEBUG
!write (*,*) 'etsf_io_geometry_copy : exit'
!ENDDEBUG

end subroutine etsf_io_geometry_copy