TABLE OF CONTENTS


etsf_io_wavedata_copy

[ Top ] [ Methods ]

NAME

etsf_io_wavedata_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_wavedata_copy(ncid_to, ncid_from, dims, lstat, error_data, &
  & split)

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

  !Local variables-------------------------------
  character(len = *), parameter :: my_name = 'etsf_io_wavedata_copy'
  type(etsf_split) :: my_split
  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_wavedata) :: folder


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

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

  lstat = .false.
  ! Variable 'basis_set'
  !  allocate and read data
  allocate(folder%basis_set)
  call etsf_io_low_read_var(ncid_from, "basis_set", &
                          & folder%basis_set, dims%character_string_length, lstat, &
                          & error_data = error_data)
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%basis_set)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "basis_set", &
                             & folder%basis_set, dims%character_string_length, lstat, &
                             & error_data = error_data)
    if (.not. lstat) then
      deallocate(folder%basis_set)
      return
    end if
  end if
  deallocate(folder%basis_set)
  
  lstat = .true.
  ! Variable 'kinetic_energy_cutoff'
  !  allocate and read data
  allocate(folder%kinetic_energy_cutoff)
  call etsf_io_low_read_var(ncid_from, "kinetic_energy_cutoff", &
                          & folder%kinetic_energy_cutoff, lstat, &
                          & error_data = error_data)
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%kinetic_energy_cutoff)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    call etsf_io_low_write_var(ncid_to, "kinetic_energy_cutoff", &
                             & folder%kinetic_energy_cutoff, lstat, &
                             & error_data = error_data)
    if (.not. lstat) then
      deallocate(folder%kinetic_energy_cutoff)
      return
    end if
  end if
  deallocate(folder%kinetic_energy_cutoff)
  
  lstat = .true.
  ! Variable 'number_of_coefficients'
  !  allocate and read data
  allocate(folder%number_of_coefficients( &
    & dims%my_number_of_kpoints))
  call etsf_io_low_read_var(ncid_from, "number_of_coefficients", &
                          & folder%number_of_coefficients, lstat, &
                          & error_data = error_data)
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%number_of_coefficients)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(1), count(1))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(1))
      allocate(jstart(1), jend(1))
      if (.not. associated(split%my_kpoints)) then
        istop(1)  = 1
        jstart(1) = 1
        jend(1)   = dims%my_number_of_kpoints
      else
        istop(1) = size(split%my_kpoints)
        count(1) = 1
      end if
      do idim1 = 1, istop(1), 1
        if (associated(split%my_kpoints)) then
          start(1)  = split%my_kpoints(idim1)
          jstart(1) = split%my_kpoints(idim1)
          jend(1)   = split%my_kpoints(idim1)
        end if
        call etsf_io_low_write_var(ncid_to, "number_of_coefficients", &
                                 & folder%number_of_coefficients(jstart(1):jend(1)), &
                                 & lstat, error_data = error_data, &
                                 & start = start, count = count)
        if (.not. lstat) then
          deallocate(folder%number_of_coefficients)
          deallocate(start, count, istop)
          deallocate(jstart, jend)
          return
        end if
      end do
      deallocate(start, count, istop)
      deallocate(jstart, jend)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "number_of_coefficients", &
                               & folder%number_of_coefficients, lstat, &
                               & error_data = error_data)
      if (.not. lstat) then
        deallocate(folder%number_of_coefficients)
        return
      end if
    end if
  end if
  deallocate(folder%number_of_coefficients)
  
  lstat = .true.
  ! Variable 'reduced_coordinates_of_plane_waves'
  !  allocate and read data
  allocate(folder%reduced_coordinates_of_plane_waves%data1D( &
    & dims%my_number_of_kpoints * &
    & dims%my_max_number_of_coefficients * &
    & dims%number_of_reduced_dimensions))
  call etsf_io_low_read_var(ncid_from, "reduced_coordinates_of_plane_waves", &
                          & folder%reduced_coordinates_of_plane_waves%data1D, lstat, &
                          & error_data = error_data)
  if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then
    deallocate(folder%reduced_coordinates_of_plane_waves%data1D)
    return
  end if
  !  write data and deallocate (if read succeed)
  if (lstat) then
    if (present(split)) then
      ! We use the split definition to write to appropriated locations.
      allocate(start(3), count(3))
      count(:) = 0
      start(:) = 1
      ! For each dimension, set the do loop boundaries,
      ! and the array boundaries.
      allocate(istop(3))
      istart   = 1
      len      = 1
      if (.not. associated(split%my_kpoints)) then
        istop(3)  = 1
        len = len * dims%my_number_of_kpoints
      else
        istop(3) = size(split%my_kpoints)
        count(3) = 1
      end if
      if (.not. associated(split%my_coefficients)) then
        istop(2)  = 1
        len = len * dims%my_max_number_of_coefficients
      else
        istop(2) = size(split%my_coefficients)
        count(2) = 1
      end if
      len = len * dims%number_of_reduced_dimensions
      do idim3 = 1, istop(3), 1
        if (associated(split%my_kpoints)) then
          start(3)  = split%my_kpoints(idim3)
        end if
        do idim2 = 1, istop(2), 1
          if (associated(split%my_coefficients)) then
            start(2)  = split%my_coefficients(idim2)
          end if
          call etsf_io_low_write_var(ncid_to, "reduced_coordinates_of_plane_waves", &
                                   & folder%reduced_coordinates_of_plane_waves%data1D(istart:istart + len - 1), &
                                   & lstat, error_data = error_data, &
                                   & start = start, count = count)
          if (.not. lstat) then
            deallocate(folder%reduced_coordinates_of_plane_waves%data1D)
            deallocate(start, count, istop)
            return
          end if
          istart = istart + len
        end do
      end do
      deallocate(start, count, istop)
    else
      ! No split information, we copy everything in the same shape.
      call etsf_io_low_write_var(ncid_to, "reduced_coordinates_of_plane_waves", &
                               & folder%reduced_coordinates_of_plane_waves%data1D, lstat, &
                               & error_data = error_data)
      if (.not. lstat) then
        deallocate(folder%reduced_coordinates_of_plane_waves%data1D)
        return
      end if
    end if
  end if
  deallocate(folder%reduced_coordinates_of_plane_waves%data1D)
  
  lstat = .true.


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

end subroutine etsf_io_wavedata_copy