223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

play it safe

This commit is contained in:
Martin Diehl 2021-07-27 09:50:23 +02:00
parent 64d52dbbf4
commit a6f7e4f1a6
2 changed files with 20 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
src/HDF5_utilities.f90
View File

@ -1479,27 +1479,34 @@ subroutine HDF5_write_str(dataset,loc_id,datasetName)
integer(HID_T), intent(in) :: loc_id
character(len=*), intent(in) :: datasetName !< name of the dataset in the file
INTEGER(HID_T) :: filetype_id, space_id, dataset_id
INTEGER :: hdferr
integer(HID_T) :: filetype_id, space_id, dataset_id
integer :: hdferr
character(len=len_trim(dataset)+1,kind=C_CHAR), dimension(1), target :: dataset_
type(C_PTR), target, dimension(1) :: ptr
dataset_(1) = trim(dataset)//C_NULL_CHAR
ptr(1) = c_loc(dataset_(1))
call h5tcopy_f(H5T_STRING, filetype_id, hdferr)
call h5tset_size_f(filetype_id, int(len(dataset_),HSIZE_T), hdferr)
call h5screate_f(H5S_SCALAR_F, space_id, hdferr)
call h5dcreate_f(loc_id, datasetName, H5T_STRING, space_id, dataset_id, hdferr)
call h5dwrite_f(dataset_id, H5T_STRING, c_loc(ptr), hdferr);
call h5tcopy_f(H5T_STRING, filetype_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5tset_size_f(filetype_id, int(len(dataset_),HSIZE_T), hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5screate_f(H5S_SCALAR_F, space_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5dcreate_f(loc_id, datasetName, H5T_STRING, space_id, dataset_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5dwrite_f(dataset_id, H5T_STRING, c_loc(ptr), hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5dclose_f(dataset_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(space_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5tclose_f(filetype_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
end subroutine HDF5_write_str

2
src/parallelization.f90
View File

@ -122,7 +122,7 @@ subroutine parallelization_bcast_str(string)
integer :: strlen, ierr ! pI64 for strlen not supported by MPI
if (worldrank == 0) strlen = string
if (worldrank == 0) strlen = len(string)
call MPI_Bcast(strlen,1,MPI_INTEGER,0,MPI_COMM_WORLD, ierr)
if (worldrank /= 0) allocate(character(len=strlen)::string)