TABLE OF CONTENTS
etsf_io_main_copy
[ Top ] [ etsf_main ] [ Methods ]
NAME
etsf_io_main_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
- ncid_to = integer returned by an 'open' NetCDF call. This id must have write access granted. It will be modified by the routine. The file must be in write mode (see etsf_io_low_set_write_mode()).
- ncid_from = integer returned by an 'open' NetCDF call. This id must have read access granted. It will be left untouched.
- dims <type(etsf_dims)> = these dimensions correspond to the source_file ones and are used to allocate temporary arrays in memory during the copy.
- split <type(etsf_split)> = (optional) if this argument is given, the values in the split definition (e.g. my_kpoints) are used to put the data in the destination file in a bigger array at the right placed.
OUTPUT
- lstat = return .true. if all the actions succeed, if not the status of the file is undefined.
- error_data <type(etsf_io_low_error)> = contains the details of the error is @lstat is false.
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_main_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_main_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_main) :: folder ! ************************************************************************* !DEBUG !write (*,*) 'etsf_io_main_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,6)) nvarids = 1 ! Variable 'density' ! allocate and read data allocate(folder%density%data1D( & & dims%my_number_of_components * & & dims%my_number_of_grid_points_vect3 * & & dims%my_number_of_grid_points_vect2 * & & dims%my_number_of_grid_points_vect1 * & & dims%real_or_complex_density)) call etsf_io_low_read_var(ncid_from, "density", & & folder%density%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%density%data1D) 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 if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(5), count(5)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(5)) istart = 1 len = 1 if (.not. associated(split%my_components)) then istop(5) = 1 len = len * dims%my_number_of_components else istop(5) = size(split%my_components) count(5) = 1 end if if (.not. associated(split%my_grid_points_vector3)) then istop(4) = 1 len = len * dims%my_number_of_grid_points_vect3 else istop(4) = size(split%my_grid_points_vector3) count(4) = 1 end if if (.not. associated(split%my_grid_points_vector2)) then istop(3) = 1 len = len * dims%my_number_of_grid_points_vect2 else istop(3) = size(split%my_grid_points_vector2) count(3) = 1 end if if (.not. associated(split%my_grid_points_vector1)) then istop(2) = 1 len = len * dims%my_number_of_grid_points_vect1 else istop(2) = size(split%my_grid_points_vector1) count(2) = 1 end if len = len * dims%real_or_complex_density do idim5 = 1, istop(5), 1 if (associated(split%my_components)) then start(5) = split%my_components(idim5) end if do idim4 = 1, istop(4), 1 if (associated(split%my_grid_points_vector3)) then start(4) = split%my_grid_points_vector3(idim4) end if do idim3 = 1, istop(3), 1 if (associated(split%my_grid_points_vector2)) then start(3) = split%my_grid_points_vector2(idim3) end if do idim2 = 1, istop(2), 1 if (associated(split%my_grid_points_vector1)) then start(2) = split%my_grid_points_vector1(idim2) end if call etsf_io_low_write_var(ncid_to, "density", & & folder%density%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%density%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do 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, "density", & & folder%density%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%density%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%density%data1D) lstat = .true. ! Variable 'exchange_potential' ! allocate and read data allocate(folder%exchange_potential%data1D( & & dims%my_number_of_components * & & dims%my_number_of_grid_points_vect3 * & & dims%my_number_of_grid_points_vect2 * & & dims%my_number_of_grid_points_vect1 * & & dims%real_or_complex_potential)) call etsf_io_low_read_var(ncid_from, "exchange_potential", & & folder%exchange_potential%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%exchange_potential%data1D) 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 if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(5), count(5)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(5)) istart = 1 len = 1 if (.not. associated(split%my_components)) then istop(5) = 1 len = len * dims%my_number_of_components else istop(5) = size(split%my_components) count(5) = 1 end if if (.not. associated(split%my_grid_points_vector3)) then istop(4) = 1 len = len * dims%my_number_of_grid_points_vect3 else istop(4) = size(split%my_grid_points_vector3) count(4) = 1 end if if (.not. associated(split%my_grid_points_vector2)) then istop(3) = 1 len = len * dims%my_number_of_grid_points_vect2 else istop(3) = size(split%my_grid_points_vector2) count(3) = 1 end if if (.not. associated(split%my_grid_points_vector1)) then istop(2) = 1 len = len * dims%my_number_of_grid_points_vect1 else istop(2) = size(split%my_grid_points_vector1) count(2) = 1 end if len = len * dims%real_or_complex_potential do idim5 = 1, istop(5), 1 if (associated(split%my_components)) then start(5) = split%my_components(idim5) end if do idim4 = 1, istop(4), 1 if (associated(split%my_grid_points_vector3)) then start(4) = split%my_grid_points_vector3(idim4) end if do idim3 = 1, istop(3), 1 if (associated(split%my_grid_points_vector2)) then start(3) = split%my_grid_points_vector2(idim3) end if do idim2 = 1, istop(2), 1 if (associated(split%my_grid_points_vector1)) then start(2) = split%my_grid_points_vector1(idim2) end if call etsf_io_low_write_var(ncid_to, "exchange_potential", & & folder%exchange_potential%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%exchange_potential%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do 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, "exchange_potential", & & folder%exchange_potential%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%exchange_potential%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%exchange_potential%data1D) lstat = .true. ! Variable 'correlation_potential' ! allocate and read data allocate(folder%correlation_potential%data1D( & & dims%my_number_of_components * & & dims%my_number_of_grid_points_vect3 * & & dims%my_number_of_grid_points_vect2 * & & dims%my_number_of_grid_points_vect1 * & & dims%real_or_complex_potential)) call etsf_io_low_read_var(ncid_from, "correlation_potential", & & folder%correlation_potential%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%correlation_potential%data1D) 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 if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(5), count(5)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(5)) istart = 1 len = 1 if (.not. associated(split%my_components)) then istop(5) = 1 len = len * dims%my_number_of_components else istop(5) = size(split%my_components) count(5) = 1 end if if (.not. associated(split%my_grid_points_vector3)) then istop(4) = 1 len = len * dims%my_number_of_grid_points_vect3 else istop(4) = size(split%my_grid_points_vector3) count(4) = 1 end if if (.not. associated(split%my_grid_points_vector2)) then istop(3) = 1 len = len * dims%my_number_of_grid_points_vect2 else istop(3) = size(split%my_grid_points_vector2) count(3) = 1 end if if (.not. associated(split%my_grid_points_vector1)) then istop(2) = 1 len = len * dims%my_number_of_grid_points_vect1 else istop(2) = size(split%my_grid_points_vector1) count(2) = 1 end if len = len * dims%real_or_complex_potential do idim5 = 1, istop(5), 1 if (associated(split%my_components)) then start(5) = split%my_components(idim5) end if do idim4 = 1, istop(4), 1 if (associated(split%my_grid_points_vector3)) then start(4) = split%my_grid_points_vector3(idim4) end if do idim3 = 1, istop(3), 1 if (associated(split%my_grid_points_vector2)) then start(3) = split%my_grid_points_vector2(idim3) end if do idim2 = 1, istop(2), 1 if (associated(split%my_grid_points_vector1)) then start(2) = split%my_grid_points_vector1(idim2) end if call etsf_io_low_write_var(ncid_to, "correlation_potential", & & folder%correlation_potential%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%correlation_potential%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do 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, "correlation_potential", & & folder%correlation_potential%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%correlation_potential%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%correlation_potential%data1D) lstat = .true. ! Variable 'exchange_correlation_potential' ! allocate and read data allocate(folder%exchange_correlation_potential%data1D( & & dims%my_number_of_components * & & dims%my_number_of_grid_points_vect3 * & & dims%my_number_of_grid_points_vect2 * & & dims%my_number_of_grid_points_vect1 * & & dims%real_or_complex_potential)) call etsf_io_low_read_var(ncid_from, "exchange_correlation_potential", & & folder%exchange_correlation_potential%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%exchange_correlation_potential%data1D) 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 if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(5), count(5)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(5)) istart = 1 len = 1 if (.not. associated(split%my_components)) then istop(5) = 1 len = len * dims%my_number_of_components else istop(5) = size(split%my_components) count(5) = 1 end if if (.not. associated(split%my_grid_points_vector3)) then istop(4) = 1 len = len * dims%my_number_of_grid_points_vect3 else istop(4) = size(split%my_grid_points_vector3) count(4) = 1 end if if (.not. associated(split%my_grid_points_vector2)) then istop(3) = 1 len = len * dims%my_number_of_grid_points_vect2 else istop(3) = size(split%my_grid_points_vector2) count(3) = 1 end if if (.not. associated(split%my_grid_points_vector1)) then istop(2) = 1 len = len * dims%my_number_of_grid_points_vect1 else istop(2) = size(split%my_grid_points_vector1) count(2) = 1 end if len = len * dims%real_or_complex_potential do idim5 = 1, istop(5), 1 if (associated(split%my_components)) then start(5) = split%my_components(idim5) end if do idim4 = 1, istop(4), 1 if (associated(split%my_grid_points_vector3)) then start(4) = split%my_grid_points_vector3(idim4) end if do idim3 = 1, istop(3), 1 if (associated(split%my_grid_points_vector2)) then start(3) = split%my_grid_points_vector2(idim3) end if do idim2 = 1, istop(2), 1 if (associated(split%my_grid_points_vector1)) then start(2) = split%my_grid_points_vector1(idim2) end if call etsf_io_low_write_var(ncid_to, "exchange_correlation_potential", & & folder%exchange_correlation_potential%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%exchange_correlation_potential%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do 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, "exchange_correlation_potential", & & folder%exchange_correlation_potential%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%exchange_correlation_potential%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%exchange_correlation_potential%data1D) lstat = .true. ! Variable 'coefficients_of_wavefunctions' ! allocate and read data allocate(folder%coefficients_of_wavefunctions%data1D( & & dims%my_number_of_spins * & & dims%my_number_of_kpoints * & & dims%my_max_number_of_states * & & dims%number_of_spinor_components * & & dims%my_max_number_of_coefficients * & & dims%real_or_complex_coefficients)) call etsf_io_low_read_var(ncid_from, "coefficients_of_wavefunctions", & & folder%coefficients_of_wavefunctions%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%coefficients_of_wavefunctions%data1D) 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 if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(6), count(6)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(6)) istart = 1 len = 1 if (.not. associated(split%my_spins)) then istop(6) = 1 len = len * dims%my_number_of_spins else istop(6) = size(split%my_spins) count(6) = 1 end if if (.not. associated(split%my_kpoints)) then istop(5) = 1 len = len * dims%my_number_of_kpoints else istop(5) = size(split%my_kpoints) count(5) = 1 end if if (.not. associated(split%my_states)) then istop(4) = 1 len = len * dims%my_max_number_of_states else istop(4) = size(split%my_states) count(4) = 1 end if len = len * dims%number_of_spinor_components 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%real_or_complex_coefficients do idim6 = 1, istop(6), 1 if (associated(split%my_spins)) then start(6) = split%my_spins(idim6) end if do idim5 = 1, istop(5), 1 if (associated(split%my_kpoints)) then start(5) = split%my_kpoints(idim5) end if do idim4 = 1, istop(4), 1 if (associated(split%my_states)) then start(4) = split%my_states(idim4) 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, "coefficients_of_wavefunctions", & & folder%coefficients_of_wavefunctions%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%coefficients_of_wavefunctions%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do 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, "coefficients_of_wavefunctions", & & folder%coefficients_of_wavefunctions%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%coefficients_of_wavefunctions%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%coefficients_of_wavefunctions%data1D) lstat = .true. ! Variable 'real_space_wavefunctions' ! allocate and read data allocate(folder%real_space_wavefunctions%data1D( & & dims%my_number_of_spins * & & dims%my_number_of_kpoints * & & dims%my_max_number_of_states * & & dims%number_of_spinor_components * & & dims%my_number_of_grid_points_vect3 * & & dims%my_number_of_grid_points_vect2 * & & dims%my_number_of_grid_points_vect1 * & & dims%real_or_complex_wavefunctions)) call etsf_io_low_read_var(ncid_from, "real_space_wavefunctions", & & folder%real_space_wavefunctions%data1D, lstat, & & error_data = error_data, ncvarid = varids(1, nvarids)) if (.not. lstat .and. error_data%access_mode_id /= ERROR_MODE_INQ) then deallocate(folder%real_space_wavefunctions%data1D) 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 if (present(split)) then ! We use the split definition to write to appropriated locations. allocate(start(8), count(8)) count(:) = 0 start(:) = 1 ! For each dimension, set the do loop boundaries, ! and the array boundaries. allocate(istop(8)) istart = 1 len = 1 if (.not. associated(split%my_spins)) then istop(8) = 1 len = len * dims%my_number_of_spins else istop(8) = size(split%my_spins) count(8) = 1 end if if (.not. associated(split%my_kpoints)) then istop(7) = 1 len = len * dims%my_number_of_kpoints else istop(7) = size(split%my_kpoints) count(7) = 1 end if if (.not. associated(split%my_states)) then istop(6) = 1 len = len * dims%my_max_number_of_states else istop(6) = size(split%my_states) count(6) = 1 end if len = len * dims%number_of_spinor_components if (.not. associated(split%my_grid_points_vector3)) then istop(4) = 1 len = len * dims%my_number_of_grid_points_vect3 else istop(4) = size(split%my_grid_points_vector3) count(4) = 1 end if if (.not. associated(split%my_grid_points_vector2)) then istop(3) = 1 len = len * dims%my_number_of_grid_points_vect2 else istop(3) = size(split%my_grid_points_vector2) count(3) = 1 end if if (.not. associated(split%my_grid_points_vector1)) then istop(2) = 1 len = len * dims%my_number_of_grid_points_vect1 else istop(2) = size(split%my_grid_points_vector1) count(2) = 1 end if len = len * dims%real_or_complex_wavefunctions do idim8 = 1, istop(8), 1 if (associated(split%my_spins)) then start(8) = split%my_spins(idim8) end if do idim7 = 1, istop(7), 1 if (associated(split%my_kpoints)) then start(7) = split%my_kpoints(idim7) end if do idim6 = 1, istop(6), 1 if (associated(split%my_states)) then start(6) = split%my_states(idim6) end if do idim4 = 1, istop(4), 1 if (associated(split%my_grid_points_vector3)) then start(4) = split%my_grid_points_vector3(idim4) end if do idim3 = 1, istop(3), 1 if (associated(split%my_grid_points_vector2)) then start(3) = split%my_grid_points_vector2(idim3) end if do idim2 = 1, istop(2), 1 if (associated(split%my_grid_points_vector1)) then start(2) = split%my_grid_points_vector1(idim2) end if call etsf_io_low_write_var(ncid_to, "real_space_wavefunctions", & & folder%real_space_wavefunctions%data1D(istart:istart + len - 1), & & lstat, error_data = error_data, & & start = start, count = count, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%real_space_wavefunctions%data1D) deallocate(start, count, istop) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if istart = istart + len end do end do end do end do 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, "real_space_wavefunctions", & & folder%real_space_wavefunctions%data1D, lstat, & & error_data = error_data, ncvarid = varids(2, nvarids)) if (.not. lstat) then deallocate(folder%real_space_wavefunctions%data1D) deallocate(varids) call etsf_io_low_error_update(error_data, my_name) return end if end if nvarids = nvarids + 1 end if deallocate(folder%real_space_wavefunctions%data1D) 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_main_copy : exit' !ENDDEBUG end subroutine etsf_io_main_copy