quantum-espresso/Modules/hdf5_qe.f90

1043 lines
38 KiB
Fortran

! Copyright (C) 2003-2016 Quantum ESPRESSO group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
#if defined(__HDF5) && defined (__MPI)
module hdf5_qe
!
USE HDF5
USE, intrinsic :: ISO_C_binding
USE Kinds, ONLY : DP
!
implicit none
!
! This module contains some common subroutines used to read and write
! in HDF5 format the data produced by Quantum ESPRESSO package.
!
! written by: Nicola Varini 2016
!
TYPE HDF5_type
INTEGER(HID_T) :: file_id ! File identifier
INTEGER(HID_T) :: dset_id ! Dataset identifier
INTEGER(HID_T) :: filespace ! Dataspace identifier in file
INTEGER(HID_T) :: memspace ! Dataspace identifier in memory
INTEGER(HID_T) :: plist_id ! Property list identifier
INTEGER(HID_T) :: group_id ! Group identifier
CHARACTER(LEN=40) :: dsetname ! Dataset name
INTEGER :: rank
INTEGER(HSIZE_T), DIMENSION(2) :: counts, counts_g, offset
INTEGER(HSIZE_T), DIMENSION(1:2) :: size
INTEGER(HID_T) :: crp_list ! Dataset creation property identifier
INTEGER :: comm
INTEGER(HSIZE_T), DIMENSION(1:2) :: maxdims
INTEGER(HSIZE_T), DIMENSION(1:2) :: chunk_dim
character(len=256) filename
END TYPE HDF5_type
TYPE(HDF5_type), save :: evc_hdf5, evc_hdf5_write, evq_hdf5_write
TYPE(HDF5_type), save :: rho_hdf5_write, eig_hdf5_write
TYPE(HDF5_type), save :: g_hdf5_write, gk_hdf5_write
INTEGER, save :: off_npw, npw_g, idone_debug
INTERFACE add_attributes_hdf5
MODULE PROCEDURE add_attributes_hdf5_i, add_attributes_hdf5_r, &
add_attributes_hdf5_c, add_attributes_hdf5_boolean
END INTERFACE
INTERFACE read_attributes_hdf5
MODULE PROCEDURE read_attributes_hdf5_i, read_attributes_hdf5_r, read_attributes_hdf5_c, &
read_attributes_hdf5_boolean
END INTERFACE
contains
subroutine initialize_hdf5()
implicit none
integer :: error
call h5open_f(error)
end subroutine initialize_hdf5
subroutine finalize_hdf5(hdf5desc)
implicit none
type(HDF5_type), intent(in) :: hdf5desc
integer :: error
call h5pclose_f(hdf5desc%plist_id,error)
call h5close_f(error)
end subroutine finalize_hdf5
subroutine h5_write_gvecs(hdf5desc, filename, nr1, nr2, nr3, ngm, gamma_only, mill)
implicit none
type (hdf5_type), intent(inout) :: hdf5desc
character(len=*), intent (in) :: filename
integer, intent(in) :: nr1, nr2, nr3, ngm
logical, intent(in) :: gamma_only
integer,intent(in) :: mill (3,ngm)
continue
end subroutine h5_write_gvecs
subroutine setup_file_property_hdf5(hdf5desc ,filename, hyperslab, write, kpoint, ierr )
use parallel_include
implicit none
type(HDF5_type), intent(inout) :: hdf5desc
character(len=*), intent(inout) :: filename
integer,optional,intent(out) :: ierr
logical, intent(in) :: hyperslab, write
integer, intent(in) :: kpoint
integer(HID_T) :: plist_id
integer :: error, info
character*12 kstring
write(kstring,'(I0)') kpoint
kstring='KPOINT'//kstring
info = MPI_INFO_NULL
if(hyperslab .eqv. .true. ) then
#if !defined (__HDF5_SERIAL)
CALL h5pcreate_f(H5P_FILE_ACCESS_F, hdf5desc%plist_id, error) ! Properties for file creation
CALL h5pset_fapl_mpio_f(hdf5desc%plist_id, hdf5desc%comm, info, error) ! Stores MPI IO communicator information to the file access property list
if(kpoint.eq.1)then
CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, hdf5desc%file_id, error, access_prp = hdf5desc%plist_id) ! create the file collectively
else
CALL h5fopen_f(filename, H5F_ACC_RDWR_F, hdf5desc%file_id, error, access_prp = hdf5desc%plist_id) ! create the file collectively
endif
CALL h5pclose_f(hdf5desc%plist_id, error)
#endif
else
if(write .eqv. .true.)then
if(kpoint.eq.1)then
!CALL h5pcreate_f(H5P_FILE_ACCESS_F, hdf5desc%plist_id, error)
!CALL h5pset_fapl_mpio_f(hdf5desc%plist_id, hdf5desc%comm, info, error)
!CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, hdf5desc%file_id, error, access_prp=hdf5desc%plist_id) ! create the file collectively
CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, hdf5desc%file_id, error)
endif
else
CALL h5fopen_f(filename, H5F_ACC_RDWR_F, hdf5desc%file_id, error)
IF (PRESENT(ierr) ) THEN
ierr = error
ELSE IF (error /= 0) THEN
CALL errore ('setup_file_property_hdf5','error opening '//filename,error)
END IF
endif
endif
end subroutine setup_file_property_hdf5
subroutine define_dataset_hdf5_hyperslab(hdf5desc, kpoint)
implicit none
type(HDF5_type), intent(inout) :: hdf5desc
integer,intent(in) :: kpoint
integer :: error
character*12 :: kstring
write(kstring,'(I0)') kpoint
kstring=trim('KPOINT')//kstring
hdf5desc%dsetname = 'evc'
CALL h5gcreate_f(hdf5desc%file_id, kstring, hdf5desc%group_id, error)
CALL h5screate_simple_f(hdf5desc%rank, hdf5desc%counts_g, hdf5desc%filespace, error) !define HDF5 dataset
CALL h5dcreate_f(hdf5desc%group_id, hdf5desc%dsetname, H5T_NATIVE_DOUBLE, hdf5desc%filespace, &
hdf5desc%dset_id, error)
CALL h5sclose_f(hdf5desc%filespace, error)
CALL h5dclose_f(hdf5desc%dset_id, error)
CALL h5gclose_f(hdf5desc%group_id, error)
end subroutine define_dataset_hdf5_hyperslab
#if !defined (__HDF5_SERIAL)
subroutine write_data_hdf5(hdf5desc, data, kpoint)
USE kinds, ONLY : DP
USE ISO_C_BINDING
implicit none
type(HDF5_type), intent(inout) :: hdf5desc
complex(kind=dp), target, intent(inout) :: data(:,:)
integer, intent(in) :: kpoint
integer :: error, datadim1, datadim2
real(kind=dp) :: tmp
integer(HID_T) :: complex_id, double_id
integer(HSIZE_T) :: double_size, complex_size
TYPE(C_PTR) :: f_ptr
character*12 :: kstring
write(kstring,'(I0)') kpoint
kstring=trim('KPOINT')//kstring
CALL h5gopen_f(hdf5desc%file_id,kstring,hdf5desc%group_id,error)
CALL h5dopen_f(hdf5desc%group_id, hdf5desc%dsetname, hdf5desc%dset_id, error)
CALL h5screate_simple_f(hdf5desc%rank, hdf5desc%counts, hdf5desc%memspace, error)
CALL h5dget_space_f(hdf5desc%dset_id, hdf5desc%filespace, error)
CALL h5sselect_hyperslab_f(hdf5desc%filespace, H5S_SELECT_SET_F, hdf5desc%offset, hdf5desc%counts, error) ! create hyperslab to read from more than 1 proc
CALL h5pcreate_f(H5P_DATASET_XFER_F, hdf5desc%plist_id, error)
CALL h5pset_dxpl_mpio_f(hdf5desc%plist_id, H5FD_MPIO_COLLECTIVE_F, error)
f_ptr = C_LOC(data(1,1))
CALL h5dwrite_f(hdf5desc%dset_id, H5T_NATIVE_DOUBLE, f_ptr, error,&
file_space_id = hdf5desc%filespace, mem_space_id = hdf5desc%memspace, &
xfer_prp = hdf5desc%plist_id)
CALL h5dclose_f(hdf5desc%dset_id, error)
CALL h5gclose_f(hdf5desc%group_id, error)
end subroutine write_data_hdf5
#endif
subroutine read_data_hdf5(hdf5desc, data, kpoint)
type(HDF5_type), intent(inout) :: hdf5desc
complex(kind=dp),target, intent(inout) :: data(:,:)
integer,intent(in) :: kpoint
integer :: error
TYPE(C_PTR) :: f_ptr
character*12 :: kstring
write(kstring,'(I0)') kpoint
kstring=trim('KPOINT')//kstring
CALL h5gopen_f(hdf5desc%file_id,kstring,hdf5desc%group_id,error)
CALL h5dopen_f(hdf5desc%group_id, hdf5desc%dsetname, hdf5desc%dset_id, error)
CALL h5dget_space_f(hdf5desc%dset_id, hdf5desc%filespace, error)
CALL h5sselect_hyperslab_f(hdf5desc%filespace, H5S_SELECT_SET_F, hdf5desc%offset, hdf5desc%counts, error)
CALL h5screate_simple_f(hdf5desc%rank, hdf5desc%counts, hdf5desc%memspace, error)
f_ptr = C_LOC(data(1,1))
CALL H5dread_f(hdf5desc%dset_id, H5T_NATIVE_DOUBLE, f_ptr, error, &
mem_space_id = hdf5desc%memspace, file_space_id = hdf5desc%filespace ,&
xfer_prp = hdf5desc%plist_id)
CALL h5dclose_f(hdf5desc%dset_id, error)
CALL h5gclose_f(hdf5desc%group_id, error)
end subroutine read_data_hdf5
SUBROUTINE prepare_index_hdf5(sendm,recm,globalm,comm,nproc)
USE parallel_include
USE mp, ONLY : mp_sum
IMPLICIT NONE
INTEGER, INTENT(IN) :: comm, nproc
INTEGER, INTENT(INOUT) :: sendm, recm, globalm
INTEGER :: errore
call mpi_scan(sendm,recm,1,MPI_INTEGER,MPI_SUM,comm,errore)
recm=recm-sendm
globalm=sendm
call mp_sum(globalm,comm)
END SUBROUTINE prepare_index_hdf5
subroutine prepare_for_writing_final(hdf5desc,comm,filename_input,kpoint,add_group)
USE io_files, ONLY : wfc_dir, prefix, tmp_dir
implicit none
type(HDF5_type), intent(inout) :: hdf5desc
character(len=*), intent(in):: filename_input
integer, intent(in) :: comm
integer, intent(in), optional :: kpoint
logical, intent(in), optional :: add_group
character(len=256) filename
integer :: ik, error
logical :: add_group_internal = .true.
character*12 kstring
hdf5desc%comm=comm
hdf5desc%filename=filename_input
if ( present (add_group) ) add_group_internal = add_group
if(present(kpoint)) then
write(kstring,'(I0)') kpoint
kstring=trim('KPOINT')//kstring
IF ( add_group_internal) THEN
CALL setup_file_property_hdf5(hdf5desc,hdf5desc%filename ,.false.,.true.,kpoint)
ELSE
CALL setup_file_property_hdf5(hdf5desc,hdf5desc%filename ,.false.,.true.,1)
END IF
CALL h5fopen_f(hdf5desc%filename, H5F_ACC_RDWR_F, hdf5desc%file_id, error) ! create the file collectively
CALL h5gcreate_f(hdf5desc%file_id, kstring, hdf5desc%group_id, error)
CALL h5gclose_f(hdf5desc%group_id, error)
else
CALL setup_file_property_hdf5(hdf5desc,hdf5desc%filename ,.false.,.true.,1)
endif
end subroutine prepare_for_writing_final
subroutine prepare_for_reading_final(hdf5desc,comm,filename_input,kpoint, ierr)
USE io_files, ONLY : wfc_dir, prefix, tmp_dir
implicit none
type(HDF5_type), intent(inout) :: hdf5desc
character(len=*), intent(in):: filename_input
integer, intent(in) :: comm
integer, intent(in), optional :: kpoint
integer, intent(out), optional :: ierr
character(len=256) filename
integer :: ik, ierr_
hdf5desc%comm=comm
hdf5desc%rank =1
!filename = trim(filename_input) //".wfchdf5"
filename=filename_input
if(present(kpoint)) then
CALL setup_file_property_hdf5(hdf5desc,filename ,.false.,.false.,KPOINT = kpoint, IERR = ierr_ )
else
CALL setup_file_property_hdf5(hdf5desc,filename ,.false.,.false.,1, IERR = ierr_)
end if
IF (PRESENT (ierr)) THEN
ierr = ierr_
ELSE
IF ( ierr_ /= 0 ) CALL errore ('prepare_for_reading_final', 'error while opening h5 file for reading',ierr_)
END IF
end subroutine prepare_for_reading_final
subroutine read_rho_hdf5(hdf5desc,dsetname,var)
USE kinds, ONLY : DP
implicit none
type(HDF5_type), intent(inout) :: hdf5desc
integer, intent(in) :: dsetname
real(kind=DP), target, intent(in) :: var(:)
INTEGER(HID_T) :: dspace_id, dset_id, dtype_id ! Dataspace identifier
integer :: error
INTEGER(HSIZE_T), DIMENSION(1) :: counts
character*12 dset_name
TYPE(C_PTR) :: f_ptr
write(dset_name,'(I0)') dsetname
dset_name='K'//dset_name
counts=size(var)
CALL h5dopen_f(hdf5desc%file_id, dset_name, dset_id, error)
CALL h5dget_type_f(dset_id, dtype_id, error)
f_ptr = C_LOC(var(1))
CALL h5dread_f(dset_id, dtype_id, f_ptr, error)
CALL h5dclose_f(dset_id, error)
end subroutine read_rho_hdf5
subroutine write_rho_hdf5(hdf5desc,dsetname,var)
USE kinds, ONLY : DP
implicit none
type(HDF5_type), intent(inout) :: hdf5desc
integer, intent(in) :: dsetname
real(kind=DP), target, intent(in) :: var(:)
INTEGER(HID_T) :: dspace_id, dset_id ! Dataspace identifier
integer :: error
INTEGER(HSIZE_T), DIMENSION(1) :: counts
character*12 dset_name
TYPE(C_PTR) :: f_ptr
write(dset_name,'(I0)') dsetname
dset_name='K'//dset_name
counts=size(var)
CALL h5screate_simple_f(1, counts, dspace_id, error) !create the dataspace
CALL h5dcreate_f(hdf5desc%file_id, dset_name, H5T_NATIVE_DOUBLE, dspace_id, &
dset_id, error)
f_ptr = C_LOC(var(1))
CALL h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE, f_ptr, error)
CALL h5dclose_f(dset_id, error)
CALL h5sclose_f(dspace_id, error)
end subroutine write_rho_hdf5
subroutine write_eig(hdf5desc,var,kpoint)
USE kinds, ONLY : DP
implicit none
type(HDF5_type), intent(inout) :: hdf5desc
integer, intent(in) :: kpoint
real(kind=DP), target, intent(in) :: var(:)
INTEGER(HID_T) :: dspace_id, dset_id ! Dataspace identifier
integer :: error
INTEGER(HSIZE_T), DIMENSION(1) :: counts
TYPE(C_PTR) :: f_ptr
character*12 kstring
write(kstring,'(I0)') kpoint
kstring='KPOINT'//kstring
counts=size(var)
CALL h5screate_simple_f(1, counts, dspace_id, error) !create the dataspace
CALL h5gopen_f(hdf5desc%file_id,kstring,hdf5desc%group_id,error)
CALL h5dcreate_f(hdf5desc%group_id, kstring, H5T_NATIVE_DOUBLE, dspace_id, &
dset_id, error)
f_ptr = C_LOC(var(1))
CALL h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE, f_ptr, error)
CALL h5dclose_f(dset_id, error)
CALL h5sclose_f(dspace_id, error)
CALL h5gclose_f(hdf5desc%group_id, error)
end subroutine write_eig
subroutine read_eig(hdf5desc,var,kpoint)
USE kinds, ONLY : DP
implicit none
type(HDF5_type), intent(inout) :: hdf5desc
integer, intent(in) :: kpoint
real(kind=DP), target, intent(inout) :: var(:)
INTEGER(HID_T) :: dtype_id, dset_id ! Dataspace identifier
integer :: error
INTEGER(HSIZE_T), DIMENSION(1) :: counts
TYPE(C_PTR) :: f_ptr
character*12 kstring
character*100 errmsg
write(kstring,'(I0)') kpoint
kstring='KPOINT'//kstring
counts=size(var)
CALL h5gopen_f(hdf5desc%file_id,kstring,hdf5desc%group_id,error)
CALL h5dopen_f(hdf5desc%group_id, kstring, dset_id, error)
CALL h5dget_type_f(dset_id, dtype_id, error)
f_ptr = C_LOC(var(1))
!CALL h5dread_f(dset_id, H5T_NATIVE_DOUBLE, f_ptr, error)
CALL h5dread_f(dset_id, dtype_id, f_ptr, error)
CALL h5dclose_f(dset_id, error)
CALL h5gclose_f(hdf5desc%group_id, error)
end subroutine read_eig
subroutine write_evc(hdf5desc,dsetname,var,kpoint)
USE kinds, ONLY : DP
implicit none
type(HDF5_type), intent(inout) :: hdf5desc
integer, intent(in) :: dsetname
integer, intent(in), optional :: kpoint
complex(kind=DP), target, intent(in) :: var(:)
INTEGER(HID_T) :: dspace_id, dset_id ! Dataspace identifier
integer :: error
INTEGER(HSIZE_T), DIMENSION(1) :: counts
character*12 dset_name
TYPE(C_PTR) :: f_ptr
character*12 kstring
write(kstring,'(I0)') kpoint
kstring='KPOINT'//kstring
write(dset_name,'(I0)') dsetname
dset_name='BAND'//dset_name
counts=size(var)*2
CALL h5screate_simple_f(1, counts, dspace_id, error) !create the dataspace
if(present(kpoint))CALL h5gopen_f(hdf5desc%file_id,kstring,hdf5desc%group_id,error)
if(present(kpoint)) then
CALL h5dcreate_f(hdf5desc%group_id, dset_name, H5T_NATIVE_DOUBLE, dspace_id, &
dset_id, error)
else
CALL h5dcreate_f(hdf5desc%file_id, dset_name, H5T_NATIVE_DOUBLE, dspace_id, &
dset_id, error)
endif
f_ptr = C_LOC(var(1))
CALL h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE, f_ptr, error)
CALL h5dclose_f(dset_id, error)
CALL h5sclose_f(dspace_id, error)
if(present(kpoint))CALL h5gclose_f(hdf5desc%group_id, error)
end subroutine write_evc
subroutine read_evc(hdf5desc,dsetname,var,kpoint)
USE kinds, ONLY : DP
implicit none
type(HDF5_type), intent(inout) :: hdf5desc
integer, intent(in) :: dsetname, kpoint
complex(kind=DP), target ,intent(inout) :: var(:)
INTEGER(HID_T) :: dtype_id, dset_id ! Dataspace identifier
integer :: error
INTEGER(HSIZE_T), DIMENSION(1) :: counts
character*12 dset_name
TYPE(C_PTR) :: f_ptr
character*12 kstring
character*100 errmsg
write(dset_name,'(I0)') dsetname
write(kstring,'(I0)') kpoint
kstring='KPOINT'//kstring
dset_name='BAND'//dset_name
counts=size(var)*2
CALL h5gopen_f(hdf5desc%file_id, kstring, hdf5desc%group_id, error)
!if(error.ne.0) call errore('error in h5gopen_f',' ',error)
CALL h5dopen_f(hdf5desc%group_id, dset_name, dset_id, error)
!if(error.ne.0) call errore('error in h5dopen_f',' ',error)
!CALL h5dget_type_f(dset_id, dtype_id, error)
f_ptr = C_LOC(var(1))
CALL h5dread_f(dset_id, H5T_NATIVE_DOUBLE, f_ptr, error)
if(error.ne.0) call errore('error in h5dread_f',' ',error)
!CALL h5dread_f(dset_id, dtype_id, f_ptr, error)
CALL h5dclose_f(dset_id, error)
CALL h5gclose_f(hdf5desc%group_id, error)
end subroutine read_evc
subroutine write_g(hdf5desc,var,kpoint)
USE kinds, ONLY : DP
implicit none
type(HDF5_type), intent(inout) :: hdf5desc
integer, intent(in), optional :: kpoint
integer, target, intent(in) :: var(:,:)
INTEGER(HID_T) :: dspace_id, dset_id ! Dataspace identifier
integer :: error
INTEGER(HSIZE_T), DIMENSION(1) :: counts
TYPE(C_PTR) :: f_ptr
character*12 kstring
counts=size(var,1)*size(var,2)
if(present(kpoint))then
write(kstring,'(I0)') kpoint
kstring='KPOINT'//kstring
CALL h5screate_simple_f(1, counts, dspace_id, error) !create the dataspace
CALL h5gopen_f(hdf5desc%file_id,kstring,hdf5desc%group_id,error)
CALL h5dcreate_f(hdf5desc%group_id, kstring, H5T_NATIVE_INTEGER, dspace_id, &
dset_id, error)
f_ptr = C_LOC(var(1,1))
CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, error)
CALL h5dclose_f(dset_id, error)
CALL h5sclose_f(dspace_id, error)
CALL h5gclose_f(hdf5desc%group_id, error)
else
CALL h5screate_simple_f(1, counts, dspace_id, error) !create the dataspace
CALL h5dcreate_f(hdf5desc%file_id, 'Miller indexes', H5T_NATIVE_INTEGER, dspace_id, &
dset_id, error)
f_ptr = C_LOC(var(1,1))
CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, error)
CALL h5dclose_f(dset_id, error)
CALL h5sclose_f(dspace_id, error)
endif
end subroutine write_g
subroutine write_gkhdf5(hdf5desc,xk,igwk,mill_g,kpoint)
USE kinds, ONLY : DP
implicit none
type(HDF5_type), intent(inout) :: hdf5desc
integer, intent(in), optional :: kpoint
real(kind=DP), target, intent(in) :: xk(:)
integer, target, intent(in) :: igwk(:), mill_g(:,:)
INTEGER(HID_T) :: dspace_id, dset_id ! Dataspace identifier
integer :: error
INTEGER(HSIZE_T), DIMENSION(1) :: counts
TYPE(C_PTR) :: f_ptr
character*12 kstring
if(present(kpoint))then
write(kstring,'(I0)') kpoint
kstring='KPOINT'//kstring
CALL h5gopen_f(hdf5desc%file_id,kstring,hdf5desc%group_id,error)
write(kstring,'(I0)') kpoint
kstring='xk'//kstring
counts=size(xk)
CALL h5screate_simple_f(1, counts, dspace_id, error) !create the dataspace
CALL h5dcreate_f(hdf5desc%group_id, kstring, H5T_NATIVE_DOUBLE, dspace_id, &
dset_id, error)
f_ptr = C_LOC(xk(1))
CALL h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE, f_ptr, error)
CALL h5dclose_f(dset_id, error)
CALL h5sclose_f(dspace_id, error)
write(kstring,'(I0)') kpoint
kstring='igwk'//kstring
counts=size(igwk)
CALL h5screate_simple_f(1, counts, dspace_id, error) !create the dataspace
CALL h5dcreate_f(hdf5desc%group_id, kstring, H5T_NATIVE_INTEGER, dspace_id, &
dset_id, error)
f_ptr = C_LOC(igwk(1))
CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, error)
CALL h5dclose_f(dset_id, error)
CALL h5sclose_f(dspace_id, error)
write(kstring,'(I0)') kpoint
kstring='mill_g'//kstring
counts=size(mill_g)
CALL h5screate_simple_f(1, counts, dspace_id, error) !create the dataspace
CALL h5dcreate_f(hdf5desc%group_id, kstring, H5T_NATIVE_INTEGER, dspace_id, &
dset_id, error)
f_ptr = C_LOC(mill_g(1,1))
CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, error)
CALL h5dclose_f(dset_id, error)
CALL h5sclose_f(dspace_id, error)
CALL h5gclose_f(hdf5desc%group_id, error)
else
counts=size(xk)
CALL h5screate_simple_f(1, counts, dspace_id, error) !create the dataspace
CALL h5dcreate_f(hdf5desc%file_id, 'xk', H5T_NATIVE_DOUBLE, dspace_id, &
dset_id, error)
f_ptr = C_LOC(xk(1))
CALL h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE, f_ptr, error)
CALL h5dclose_f(dset_id, error)
CALL h5sclose_f(dspace_id, error)
counts=size(igwk)
CALL h5screate_simple_f(1, counts, dspace_id, error) !create the dataspace
CALL h5dcreate_f(hdf5desc%file_id, 'igwk', H5T_NATIVE_INTEGER, dspace_id, &
dset_id, error)
f_ptr = C_LOC(igwk(1))
CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, error)
CALL h5dclose_f(dset_id, error)
CALL h5sclose_f(dspace_id, error)
counts=size(mill_g)
CALL h5screate_simple_f(1, counts, dspace_id, error) !create the dataspace
CALL h5dcreate_f(hdf5desc%group_id, 'mill_g', H5T_NATIVE_INTEGER, dspace_id, &
dset_id, error)
f_ptr = C_LOC(mill_g(1,1))
CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, error)
CALL h5dclose_f(dset_id, error)
CALL h5sclose_f(dspace_id, error)
endif
end subroutine write_gkhdf5
subroutine initialize_io_hdf5(hdf5desc,comm, data, write,kpoint)
USE io_files, ONLY : wfc_dir, prefix, tmp_dir
USE kinds, ONLY : dp
USE mp_world, ONLY : nproc
implicit none
TYPE(HDF5_type), intent(inout) :: hdf5desc
complex(kind=dp), intent(in) :: data(:,:)
integer, intent(in) :: comm, kpoint
logical, intent(in) :: write
character(len=80) :: filename
integer :: npwx, nbnd
npwx=size(data(:,1))
nbnd=size(data(1,:))
filename=trim(tmp_dir) //TRIM(prefix) //".wfchdf5"
call initialize_hdf5_array(hdf5desc,comm,npwx,nbnd)
if(write .eqv. .true.)then
CALL setup_file_property_hdf5(hdf5desc, filename,.true.,.true.,kpoint)
else
CALL setup_file_property_hdf5(hdf5desc, filename,.false.,.false.,kpoint)
endif
CALL prepare_index_hdf5(npwx,off_npw,npw_g,hdf5desc%comm,nproc)
CALL set_index_hdf5(hdf5desc,data,off_npw,npw_g,2)
end subroutine initialize_io_hdf5
subroutine initialize_hdf5_array(hdf5desc,comm,n1,n2)
implicit none
integer, intent(in) :: n1, n2, comm
type(HDF5_type), intent(inout) :: hdf5desc
hdf5desc%dsetname="evc"
hdf5desc%comm=comm
hdf5desc%rank =2
hdf5desc%chunk_dim=(/n1,n2/)
hdf5desc%size(1) = n1*2
hdf5desc%size(2) = n2
hdf5desc%offset(1) = 0
hdf5desc%offset(2) = 0
end subroutine initialize_hdf5_array
SUBROUTINE set_index_hdf5(hdf5desc, var, offset, nglobal,tsize)
USE kinds, only : DP
implicit none
COMPLEX(DP), intent(in) :: var(:,:)
type(HDF5_type), intent(inout) :: hdf5desc
INTEGER, intent(in) :: offset, nglobal,tsize
hdf5desc%counts(1) = size(var(:,1))*tsize
hdf5desc%counts(2) = size(var(1,:))
hdf5desc%counts_g(1) = nglobal*tsize
hdf5desc%counts_g(2) = size(var(1,:))
hdf5desc%offset(1) = offset*tsize
hdf5desc%offset(2) = 0
END SUBROUTINE set_index_hdf5
SUBROUTINE add_attributes_hdf5_i(hdf5desc, attr_data, attr_name, kpoint)
implicit none
TYPE(HDF5_type), intent(inout) :: hdf5desc
integer, intent(in) :: attr_data
integer, intent(in),optional :: kpoint
CHARACTER(LEN=*), intent(in) :: attr_name
character*12 kstring
integer :: error
INTEGER :: arank = 1 ! Attribure rank
INTEGER(HID_T) :: aspace_id ! Attribute Dataspace identifier
INTEGER(HSIZE_T), DIMENSION(1) :: adims = (/1/) ! Attribute dimension
INTEGER(SIZE_T) :: attrlen ! Length of the attribute string
INTEGER(HID_T) :: atype_id ! Attribute Dataspace identifier
INTEGER(HID_T) :: attr_id ! Attribute Dataspace identifier
INTEGER(HSIZE_T), DIMENSION(1) :: data_dims
data_dims(1) = 1
if(present(kpoint)) then
write(kstring,'(I0)') kpoint
kstring='KPOINT'//kstring
CALL h5gopen_f(hdf5desc%file_id,kstring,hdf5desc%group_id,error)
CALL h5screate_simple_f(arank, adims, aspace_id, error)
CALL h5acreate_f(hdf5desc%group_id, attr_name, H5T_NATIVE_INTEGER, aspace_id, attr_id, error)
CALL h5awrite_f(attr_id, H5T_NATIVE_INTEGER, attr_data, data_dims, error)
CALL h5aclose_f(attr_id, error)
!
! Terminate access to the data space.
!
CALL h5sclose_f(aspace_id, error)
!
! End access to the dataset and release resources used by it.
!
CALL h5gclose_f(hdf5desc%group_id, error)
else
CALL h5screate_simple_f(arank, adims, aspace_id, error)
CALL h5acreate_f(hdf5desc%file_id, attr_name, H5T_NATIVE_INTEGER, aspace_id, attr_id, error)
CALL h5awrite_f(attr_id, H5T_NATIVE_INTEGER, attr_data, data_dims, error)
CALL h5aclose_f(attr_id, error)
!
! Terminate access to the data space.
!
CALL h5sclose_f(aspace_id, error)
endif
END SUBROUTINE add_attributes_hdf5_i
SUBROUTINE add_attributes_hdf5_r(hdf5desc, attr_data, attr_name, kpoint)
implicit none
TYPE(HDF5_type), intent(inout) :: hdf5desc
integer, intent(in), optional :: kpoint
real(DP), intent(in) :: attr_data
CHARACTER(LEN=*), intent(in) :: attr_name
character*12 kstring
integer :: error
INTEGER :: arank = 1 ! Attribure rank
INTEGER(HID_T) :: aspace_id ! Attribute Dataspace identifier
INTEGER(HSIZE_T), DIMENSION(1) :: adims = (/1/) ! Attribute dimension
INTEGER(SIZE_T) :: attrlen ! Length of the attribute string
INTEGER(HID_T) :: atype_id ! Attribute Dataspace identifier
INTEGER(HID_T) :: attr_id ! Attribute Dataspace identifier
INTEGER(HSIZE_T), DIMENSION(1) :: data_dims
data_dims(1) = 1
if(present(kpoint)) then
write(kstring,'(I0)') kpoint
kstring='KPOINT'//kstring
CALL h5gopen_f(hdf5desc%file_id,kstring,hdf5desc%group_id,error)
CALL h5screate_simple_f(arank, adims, aspace_id, error)
CALL h5acreate_f(hdf5desc%group_id, attr_name, H5T_NATIVE_DOUBLE, aspace_id, attr_id, error)
CALL h5awrite_f(attr_id, H5T_NATIVE_DOUBLE, attr_data, data_dims, error)
CALL h5aclose_f(attr_id, error)
!
! Terminate access to the data space.
!
CALL h5sclose_f(aspace_id, error)
!
! End access to the dataset and release resources used by it.
!
CALL h5gclose_f(hdf5desc%group_id, error)
else
CALL h5screate_simple_f(arank, adims, aspace_id, error)
CALL h5acreate_f(hdf5desc%file_id, attr_name, H5T_NATIVE_DOUBLE, aspace_id, attr_id, error)
CALL h5awrite_f(attr_id, H5T_NATIVE_DOUBLE, attr_data, data_dims, error)
CALL h5aclose_f(attr_id, error)
!
! Terminate access to the data space.
!
CALL h5sclose_f(aspace_id, error)
!
! End access to the dataset and release resources used by it.
!
endif
END SUBROUTINE add_attributes_hdf5_r
SUBROUTINE add_attributes_hdf5_c(hdf5desc, attr_data, attr_name, kpoint)
IMPLICIT NONE
TYPE(HDF5_type), intent(inout) :: hdf5desc
INTEGER, INTENT(IN), OPTIONAL :: kpoint
CHARACTER(LEN=*),TARGET, INTENT(IN) :: attr_data
CHARACTER(LEN=*), intent(in) :: attr_name
CHARACTER*100 kstring
INTEGER :: error
INTEGER :: arank = 1 ! Attribure rank
INTEGER(HID_T) :: aspace_id ! Attribute Dataspace identifier
INTEGER(HSIZE_T) :: attrlen ! Length of the attribute string
INTEGER(HID_T) :: atype_id ! Attribute Dataspace identifier
INTEGER(HID_T) :: attr_id ! Attribute Dataspace identifier
TYPE(C_PTR) :: buf
!
buf = C_LOC(attr_data)
attrlen = LEN(TRIM(attr_data) )
CALL H5Screate_f( H5S_SCALAR_F, aspace_id, error)
CALL H5Tcopy_f ( H5T_FORTRAN_S1, atype_id, error )
CALL H5Tset_size_f( atype_id, attrlen, error)
IF(PRESENT(kpoint)) THEN
WRITE(kstring,'(I0)') kpoint
kstring='KPOINT'//kstring
!write(attrdata,'(I0)') attr_data
CALL h5gopen_f(hdf5desc%file_id,kstring,hdf5desc%group_id,error)
CALL h5acreate_f(hdf5desc%group_id, attr_name, atype_id, aspace_id, attr_id, error)
CALL h5awrite_f(attr_id, atype_id, buf, error)
CALL h5aclose_f(attr_id, error)
!
! End access to the dataset and release resources used by it.
!
CALL h5gclose_f(hdf5desc%group_id, error)
ELSE
!write(attrdata,'(I0)') attr_data
CALL h5acreate_f(hdf5desc%file_id, attr_name, atype_id, aspace_id, attr_id, error)
CALL h5awrite_f(attr_id, atype_id, buf, error)
CALL h5aclose_f(attr_id, error)
!
! Terminate access to the data space.
!
ENDIF
CALL H5Sclose_f(aspace_id, error)
CALL H5Tclose_f(atype_id, error )
END SUBROUTINE add_attributes_hdf5_c
!
SUBROUTINE add_attributes_hdf5_boolean(hdf5desc, attr_data, attr_name, kpoint)
IMPLICIT NONE
TYPE(HDF5_type), intent(inout) :: hdf5desc
INTEGER, INTENT(IN), OPTIONAL :: kpoint
LOGICAL,INTENT(IN) :: attr_data
CHARACTER(LEN=*), intent(in) :: attr_name
CHARACTER*100 kstring
INTEGER :: error
INTEGER :: arank = 1 ! Attribure rank
INTEGER(HID_T) :: aspace_id ! Attribute Dataspace identifier
INTEGER(HSIZE_T) :: attrlen ! Length of the attribute string
INTEGER(HID_T) :: atype_id ! Attribute Dataspace identifier
INTEGER(HID_T) :: attr_id ! Attribute Dataspace identifier
CHARACTER(LEN=7),TARGET :: string_data
TYPE(C_PTR) :: buf
!
IF (attr_data) THEN
string_data = '.TRUE.'
ELSE
string_data ='.FALSE.'
END IF
buf = C_LOC(string_data)
attrlen = LEN(TRIM(string_data) )
CALL H5Screate_f( H5S_SCALAR_F, aspace_id, error)
CALL H5Tcopy_f ( H5T_FORTRAN_S1, atype_id, error )
CALL H5Tset_size_f( atype_id, attrlen, error)
IF(PRESENT(kpoint)) THEN
WRITE(kstring,'(I0)') kpoint
kstring='KPOINT'//kstring
!write(attrdata,'(I0)') attr_data
CALL h5gopen_f(hdf5desc%file_id,kstring,hdf5desc%group_id,error)
CALL h5acreate_f(hdf5desc%group_id, attr_name, atype_id, aspace_id, attr_id, error)
CALL h5awrite_f(attr_id, atype_id, buf, error)
CALL h5aclose_f(attr_id, error)
!
! End access to the dataset and release resources used by it.
!
CALL h5gclose_f(hdf5desc%group_id, error)
ELSE
!write(attrdata,'(I0)') attr_data
CALL h5acreate_f(hdf5desc%file_id, attr_name, atype_id, aspace_id, attr_id, error)
CALL h5awrite_f(attr_id, atype_id, buf, error)
CALL h5aclose_f(attr_id, error)
!
! Terminate access to the data space.
!
ENDIF
CALL H5Sclose_f(aspace_id, error)
CALL H5Tclose_f(atype_id, error )
END SUBROUTINE add_attributes_hdf5_boolean
SUBROUTINE read_attributes_hdf5_i(hdf5desc, attr_data, attr_name, kpoint, debug)
implicit none
TYPE(HDF5_type), intent(inout) :: hdf5desc
integer, intent(in), optional :: kpoint, debug
integer, intent(out) :: attr_data
CHARACTER(LEN=*), intent(in) :: attr_name
character*12 kstring
integer :: error
INTEGER :: arank = 1 ! Attribure rank
INTEGER(HID_T) :: aspace_id ! Attribute Dataspace identifier
INTEGER(HSIZE_T), DIMENSION(1) :: adims = (/1/) ! Attribute dimension
INTEGER(SIZE_T) :: attrlen ! Length of the attribute string
INTEGER(HID_T) :: atype_id ! Attribute Dataspace identifier
INTEGER(HID_T) :: attr_id ! Attribute Dataspace identifier
INTEGER(HSIZE_T), DIMENSION(1) :: data_dims
data_dims(1) = 1
attrlen = 1
if(present(kpoint))then
write(kstring,'(I0)') kpoint
kstring='KPOINT'//kstring
CALL h5gopen_f(hdf5desc%file_id,kstring,hdf5desc%group_id,error)
CALL h5aopen_name_f(hdf5desc%group_id,attr_name,attr_id,error)
CALL h5aread_f(attr_id, H5T_NATIVE_INTEGER, attr_data, data_dims, error)
CALL h5aclose_f(attr_id, error)
CALL h5gclose_f(hdf5desc%group_id, error)
else
CALL h5aopen_name_f(hdf5desc%file_id,attr_name,attr_id,error)
CALL h5aget_type_f(attr_id, atype_id, error)
CALL h5aread_f(attr_id, atype_id, attr_data, data_dims, error)
CALL h5aclose_f(attr_id, error)
endif
END SUBROUTINE read_attributes_hdf5_i
SUBROUTINE read_attributes_hdf5_c(hdf5desc, attr_data, attr_name, kpoint, debug)
implicit none
TYPE(HDF5_type), intent(inout) :: hdf5desc
integer, intent(in), optional :: kpoint, debug
CHARACTER(LEN=*),INTENT(OUT) :: attr_data
CHARACTER(LEN=*), intent(in) :: attr_name
character*12 kstring
integer :: error
INTEGER(HID_T) :: aspace_id ! Attribute Dataspace identifier
INTEGER(HSIZE_T) :: attrlen ! Length of the attribute string
INTEGER(HID_T) :: atype_id ! Attribute Dataspace identifier
INTEGER(HID_T) :: attr_id ! Attribute Dataspace identifier
CHARACTER,TARGET,ALLOCATABLE :: chars(:)
TYPE(C_PTR) :: buf
IF(PRESENT( kpoint )) THEN
WRITE(kstring,'(I0)') kpoint
kstring='KPOINT'//kstring
CALL H5Gopen_f(hdf5desc%file_id,kstring,hdf5desc%group_id,error)
CALL H5Aopen_by_name_f(hdf5desc%group_id,'.', TRIM(attr_name) , attr_id, error)
CALL extract_string
CALL H5Aclose_f(attr_id, error)
CALL H5Gclose_f(hdf5desc%group_id, error)
ELSE
CALL h5aopen_by_name_f(hdf5desc%file_id,'.',TRIM(attr_name), attr_id, error)
CALL extract_string
CALL h5aclose_f(attr_id, error)
ENDIF
CALL H5Tclose_f( atype_id, error )
CONTAINS
SUBROUTINE extract_string
IMPLICIT NONE
INTEGER :: i
CALL H5Aget_type_f (attr_id , atype_id, error )
CALL H5Tget_size_f (atype_id, attrlen, error )
IF ( attrlen .GT. LEN(attr_data) ) CALL infomsg ('read_attributes_hdf5',&
'string attribute on file too long, it will be truncated on reading')
ALLOCATE ( chars(attrlen) )
buf = C_LOC (chars)
CALL H5Aread_f( attr_id, atype_id, buf, error )
DO i =1, attrlen
IF ( i .GT. LEN( attr_data) ) EXIT
attr_data(i:i) = chars(i)
END DO
DEALLOCATE(chars)
buf = C_NULL_PTR
END SUBROUTINE extract_string
END SUBROUTINE read_attributes_hdf5_c
SUBROUTINE read_attributes_hdf5_boolean( hdf5desc, attr_data, attr_name, kpoint, debug)
IMPLICIT NONE
TYPE(HDF5_type), intent(inout) :: hdf5desc
INTEGER, INTENT(IN), OPTIONAL :: kpoint, debug
LOGICAL,INTENT(OUT) :: attr_data
CHARACTER(LEN=*), intent(in) :: attr_name
!
CHARACTER(LEN=10) :: attr_string
CALL read_attributes_hdf5_c( hdf5desc, attr_string, attr_name, kpoint, debug)
SELECT CASE (TRIM( attr_string) )
CASE ('.TRUE.' )
attr_data = .TRUE.
CASE ('.FALSE.')
attr_data = .FALSE.
CASE DEFAULT
attr_data = .FALSE.
CALL infomsg ( 'read_attributes_hdf5' , 'error reading attribute '//TRIM(attr_name)//' value set to .FALSE.')
END SELECT
END SUBROUTINE read_attributes_hdf5_boolean
SUBROUTINE read_attributes_hdf5_r(hdf5desc, attr_data, attr_name, kpoint)
implicit none
TYPE(HDF5_type), intent(inout) :: hdf5desc
integer, intent(in), optional :: kpoint
real(DP), intent(out) :: attr_data
CHARACTER(LEN=*), intent(in) :: attr_name
character*12 kstring
integer :: error
INTEGER :: arank = 1 ! Attribure rank
INTEGER(HID_T) :: aspace_id ! Attribute Dataspace identifier
INTEGER(HSIZE_T), DIMENSION(1) :: adims = (/1/) ! Attribute dimension
INTEGER(SIZE_T) :: attrlen ! Length of the attribute string
INTEGER(HID_T) :: atype_id ! Attribute Dataspace identifier
INTEGER(HID_T) :: attr_id ! Attribute Dataspace identifier
INTEGER(HSIZE_T), DIMENSION(1) :: data_dims
data_dims(1) = 1
attrlen = 1
if(present(kpoint))then
write(kstring,'(I0)') kpoint
kstring='KPOINT'//kstring
CALL h5gopen_f(hdf5desc%file_id,kstring,hdf5desc%group_id,error)
CALL h5aopen_name_f(hdf5desc%group_id,attr_name,attr_id,error)
CALL h5aread_f(attr_id, H5T_NATIVE_DOUBLE, attr_data, data_dims, error)
CALL h5aclose_f(attr_id, error)
CALL h5gclose_f(hdf5desc%group_id, error)
else
CALL h5aopen_name_f(hdf5desc%file_id,attr_name,attr_id,error)
CALL h5aread_f(attr_id, H5T_NATIVE_DOUBLE, attr_data, data_dims, error)
CALL h5aclose_f(attr_id, error)
endif
END SUBROUTINE read_attributes_hdf5_r
SUBROUTINE hdf5_close(hdf5desc)
implicit none
TYPE(HDF5_type), intent(inout) :: hdf5desc
integer :: errore
CALL h5fclose_f(hdf5desc%file_id,errore)
END SUBROUTINE hdf5_close
SUBROUTINE write_attributes(hdf5desc, ngw, gamma_only, igwx, &
nbnd, ik, nk, ispin, nspin, scalef)
implicit none
INTEGER, INTENT(IN) :: ik, nk, ispin, nspin
REAL(DP), INTENT(IN) :: scalef
LOGICAL, INTENT(IN) :: gamma_only
INTEGER, INTENT(IN) :: nbnd, ngw, igwx
TYPE(HDF5_type), intent(inout) :: hdf5desc
CALL add_attributes_hdf5(hdf5desc,ngw,"ngw",ik)
CALL add_attributes_hdf5(evc_hdf5_write,gamma_only,"gamma_only",ik)
CALL add_attributes_hdf5(evc_hdf5_write,igwx,"igwx",ik)
CALL add_attributes_hdf5(evc_hdf5_write,nbnd,"nbnd",ik)
CALL add_attributes_hdf5(evc_hdf5_write,ik,"ik",ik)
CALL add_attributes_hdf5(evc_hdf5_write,nk,"nk",ik)
CALL add_attributes_hdf5(evc_hdf5_write,ispin,"ispin",ik)
CALL add_attributes_hdf5(evc_hdf5_write,nspin,"nspin",ik)
CALL add_attributes_hdf5(evc_hdf5_write,scalef,"scale_factor",ik)
END SUBROUTINE write_attributes
end module hdf5_qe
#else
module hdf5_qe
implicit none
integer :: pippo
end module hdf5_qe
#endif