Merge branch 'select-rank-hdf5' into 'development'
avoid code duplication by using assumed rank "(..)" Closes #183 See merge request damask/DAMASK!562
This commit is contained in:
commit
e8c1f84539
|
@ -48,6 +48,7 @@ module HDF5_utilities
|
||||||
!> @details for parallel IO, all dimension except for the last need to match
|
!> @details for parallel IO, all dimension except for the last need to match
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
interface HDF5_write
|
interface HDF5_write
|
||||||
|
#if defined(__GFORTRAN__) && __GNUC__<11
|
||||||
module procedure HDF5_write_real1
|
module procedure HDF5_write_real1
|
||||||
module procedure HDF5_write_real2
|
module procedure HDF5_write_real2
|
||||||
module procedure HDF5_write_real3
|
module procedure HDF5_write_real3
|
||||||
|
@ -55,7 +56,6 @@ module HDF5_utilities
|
||||||
module procedure HDF5_write_real5
|
module procedure HDF5_write_real5
|
||||||
module procedure HDF5_write_real6
|
module procedure HDF5_write_real6
|
||||||
module procedure HDF5_write_real7
|
module procedure HDF5_write_real7
|
||||||
|
|
||||||
module procedure HDF5_write_int1
|
module procedure HDF5_write_int1
|
||||||
module procedure HDF5_write_int2
|
module procedure HDF5_write_int2
|
||||||
module procedure HDF5_write_int3
|
module procedure HDF5_write_int3
|
||||||
|
@ -63,6 +63,10 @@ module HDF5_utilities
|
||||||
module procedure HDF5_write_int5
|
module procedure HDF5_write_int5
|
||||||
module procedure HDF5_write_int6
|
module procedure HDF5_write_int6
|
||||||
module procedure HDF5_write_int7
|
module procedure HDF5_write_int7
|
||||||
|
#else
|
||||||
|
module procedure HDF5_write_real
|
||||||
|
module procedure HDF5_write_int
|
||||||
|
#endif
|
||||||
end interface HDF5_write
|
end interface HDF5_write
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
|
@ -1210,6 +1214,7 @@ subroutine HDF5_read_int7(dataset,loc_id,datasetName,parallel)
|
||||||
|
|
||||||
end subroutine HDF5_read_int7
|
end subroutine HDF5_read_int7
|
||||||
|
|
||||||
|
#if defined(__GFORTRAN__) && __GNUC__<11
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief write dataset of type real with 1 dimension
|
!> @brief write dataset of type real with 1 dimension
|
||||||
|
@ -1499,6 +1504,71 @@ subroutine HDF5_write_real7(dataset,loc_id,datasetName,parallel)
|
||||||
|
|
||||||
end subroutine HDF5_write_real7
|
end subroutine HDF5_write_real7
|
||||||
|
|
||||||
|
#else
|
||||||
|
|
||||||
|
!--------------------------------------------------------------------------------------------------
|
||||||
|
!> @brief write dataset of type real with 1-7 dimension
|
||||||
|
!--------------------------------------------------------------------------------------------------
|
||||||
|
subroutine HDF5_write_real(dataset,loc_id,datasetName,parallel)
|
||||||
|
|
||||||
|
real(pReal), intent(in), dimension(..) :: dataset !< data written to file
|
||||||
|
integer(HID_T), intent(in) :: loc_id !< file or group handle
|
||||||
|
character(len=*), intent(in) :: datasetName !< name of the dataset in the file
|
||||||
|
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
|
||||||
|
|
||||||
|
|
||||||
|
integer :: hdferr
|
||||||
|
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
|
||||||
|
integer(HSIZE_T), dimension(rank(dataset)) :: &
|
||||||
|
myStart, &
|
||||||
|
myShape, & !< shape of the dataset (this process)
|
||||||
|
totalShape !< shape of the dataset (all processes)
|
||||||
|
|
||||||
|
!---------------------------------------------------------------------------------------------------
|
||||||
|
! determine shape of dataset
|
||||||
|
myShape = int(shape(dataset),HSIZE_T)
|
||||||
|
if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty)
|
||||||
|
|
||||||
|
if (present(parallel)) then
|
||||||
|
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
|
||||||
|
myStart, totalShape,loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel)
|
||||||
|
else
|
||||||
|
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
|
||||||
|
myStart, totalShape,loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default)
|
||||||
|
end if
|
||||||
|
|
||||||
|
if (product(totalShape) /= 0) then
|
||||||
|
select rank(dataset)
|
||||||
|
rank (1)
|
||||||
|
call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||||
|
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||||
|
rank (2)
|
||||||
|
call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||||
|
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||||
|
rank (3)
|
||||||
|
call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||||
|
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||||
|
rank (4)
|
||||||
|
call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||||
|
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||||
|
rank (5)
|
||||||
|
call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||||
|
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||||
|
rank (6)
|
||||||
|
call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||||
|
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||||
|
rank (7)
|
||||||
|
call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||||
|
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||||
|
end select
|
||||||
|
if(hdferr < 0) error stop 'HDF5 error'
|
||||||
|
end if
|
||||||
|
|
||||||
|
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||||
|
|
||||||
|
end subroutine HDF5_write_real
|
||||||
|
#endif
|
||||||
|
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief Write dataset of type string (scalar).
|
!> @brief Write dataset of type string (scalar).
|
||||||
|
@ -1561,6 +1631,7 @@ subroutine HDF5_write_str(dataset,loc_id,datasetName)
|
||||||
|
|
||||||
end subroutine HDF5_write_str
|
end subroutine HDF5_write_str
|
||||||
|
|
||||||
|
#if defined(__GFORTRAN__) && __GNUC__<11
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief write dataset of type integer with 1 dimension
|
!> @brief write dataset of type integer with 1 dimension
|
||||||
|
@ -1849,6 +1920,70 @@ subroutine HDF5_write_int7(dataset,loc_id,datasetName,parallel)
|
||||||
|
|
||||||
end subroutine HDF5_write_int7
|
end subroutine HDF5_write_int7
|
||||||
|
|
||||||
|
#else
|
||||||
|
|
||||||
|
!--------------------------------------------------------------------------------------------------
|
||||||
|
!> @brief write dataset of type integer with 1-7 dimension
|
||||||
|
!--------------------------------------------------------------------------------------------------
|
||||||
|
subroutine HDF5_write_int(dataset,loc_id,datasetName,parallel)
|
||||||
|
|
||||||
|
integer, intent(in), dimension(..) :: dataset !< data written to file
|
||||||
|
integer(HID_T), intent(in) :: loc_id !< file or group handle
|
||||||
|
character(len=*), intent(in) :: datasetName !< name of the dataset in the file
|
||||||
|
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
|
||||||
|
|
||||||
|
|
||||||
|
integer :: hdferr
|
||||||
|
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
|
||||||
|
integer(HSIZE_T), dimension(rank(dataset)) :: &
|
||||||
|
myStart, &
|
||||||
|
myShape, & !< shape of the dataset (this process)
|
||||||
|
totalShape !< shape of the dataset (all processes)
|
||||||
|
|
||||||
|
!---------------------------------------------------------------------------------------------------
|
||||||
|
! determine shape of dataset
|
||||||
|
myShape = int(shape(dataset),HSIZE_T)
|
||||||
|
if (any(myShape(1:size(myShape)-1) == 0)) return !< empty dataset (last dimension can be empty)
|
||||||
|
|
||||||
|
if (present(parallel)) then
|
||||||
|
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
|
||||||
|
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel)
|
||||||
|
else
|
||||||
|
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
|
||||||
|
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default)
|
||||||
|
end if
|
||||||
|
|
||||||
|
if (product(totalShape) /= 0) then
|
||||||
|
select rank(dataset)
|
||||||
|
rank(1)
|
||||||
|
call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||||
|
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||||
|
rank(2)
|
||||||
|
call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||||
|
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||||
|
rank(3)
|
||||||
|
call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||||
|
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||||
|
rank(4)
|
||||||
|
call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||||
|
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||||
|
rank(5)
|
||||||
|
call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||||
|
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||||
|
rank(6)
|
||||||
|
call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||||
|
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||||
|
rank(7)
|
||||||
|
call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
|
||||||
|
file_space_id = filespace_id, mem_space_id = memspace_id, xfer_prp = plist_id)
|
||||||
|
end select
|
||||||
|
if(hdferr < 0) error stop 'HDF5 error'
|
||||||
|
end if
|
||||||
|
|
||||||
|
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
|
||||||
|
|
||||||
|
end subroutine HDF5_write_int
|
||||||
|
#endif
|
||||||
|
|
||||||
!--------------------------------------------------------------------------------------------------
|
!--------------------------------------------------------------------------------------------------
|
||||||
!> @brief initialize HDF5 handles, determines global shape and start for parallel read
|
!> @brief initialize HDF5 handles, determines global shape and start for parallel read
|
||||||
|
|
|
@ -658,11 +658,7 @@ function om2ax(om) result(ax)
|
||||||
else
|
else
|
||||||
call dgeev('N','V',3,om_,3,Wr,Wi,devNull,3,VR,3,work,size(work,1),ierr)
|
call dgeev('N','V',3,om_,3,Wr,Wi,devNull,3,VR,3,work,size(work,1),ierr)
|
||||||
if (ierr /= 0) error stop 'LAPACK error'
|
if (ierr /= 0) error stop 'LAPACK error'
|
||||||
#if defined(__GFORTRAN__) && __GNUC__<9
|
|
||||||
i = maxloc(merge(1,0,cEq(cmplx(Wr,Wi,pReal),cmplx(1.0_pReal,0.0_pReal,pReal),tol=1.0e-14_pReal)),dim=1)
|
|
||||||
#else
|
|
||||||
i = findloc(cEq(cmplx(Wr,Wi,pReal),cmplx(1.0_pReal,0.0_pReal,pReal),tol=1.0e-14_pReal),.true.,dim=1) !find eigenvalue (1,0)
|
i = findloc(cEq(cmplx(Wr,Wi,pReal),cmplx(1.0_pReal,0.0_pReal,pReal),tol=1.0e-14_pReal),.true.,dim=1) !find eigenvalue (1,0)
|
||||||
#endif
|
|
||||||
if (i == 0) error stop 'om2ax conversion failed'
|
if (i == 0) error stop 'om2ax conversion failed'
|
||||||
ax(1:3) = VR(1:3,i)
|
ax(1:3) = VR(1:3,i)
|
||||||
where ( dNeq0([om(2,3)-om(3,2), om(3,1)-om(1,3), om(1,2)-om(2,1)])) &
|
where ( dNeq0([om(2,3)-om(3,2), om(3,1)-om(1,3), om(1,2)-om(2,1)])) &
|
||||||
|
@ -1427,10 +1423,6 @@ subroutine selfTest()
|
||||||
|
|
||||||
do i = 1, 20
|
do i = 1, 20
|
||||||
|
|
||||||
#if defined(__GFORTRAN__) && __GNUC__<9
|
|
||||||
if(i<7) cycle
|
|
||||||
#endif
|
|
||||||
|
|
||||||
if(i==1) then
|
if(i==1) then
|
||||||
qu = om2qu(math_I3)
|
qu = om2qu(math_I3)
|
||||||
elseif(i==2) then
|
elseif(i==2) then
|
||||||
|
|
Loading…
Reference in New Issue