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

Merge branch 'polishing' into 'development' 

Polishing

See merge request damask/DAMASK!473
This commit is contained in:
Daniel Otto de Mentock 2021-12-06 12:57:17 +00:00
parent cef8b06dc0 8ade749f05
commit 65c4417a20
7 changed files with 291 additions and 295 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
python/damask/mechanics.py
View File

@ -19,12 +19,12 @@ def deformation_Cauchy_Green_left(F: _np.ndarray) -> _np.ndarray:
Parameters
----------
F : numpy.ndarray of shape (...,3,3)
F : numpy.ndarray, shape (...,3,3)
Deformation gradient.
Returns
-------
B : numpy.ndarray of shape (...,3,3)
B : numpy.ndarray, shape (...,3,3)
Left Cauchy-Green deformation tensor.
"""
@ -37,12 +37,12 @@ def deformation_Cauchy_Green_right(F: _np.ndarray) -> _np.ndarray:
Parameters
----------
F : numpy.ndarray of shape (...,3,3)
F : numpy.ndarray, shape (...,3,3)
Deformation gradient.
Returns
-------
C : numpy.ndarray of shape (...,3,3)
C : numpy.ndarray, shape (...,3,3)
Right Cauchy-Green deformation tensor.
"""
@ -55,12 +55,12 @@ def equivalent_strain_Mises(epsilon: _np.ndarray) -> _np.ndarray:
Parameters
----------
epsilon : numpy.ndarray of shape (...,3,3)
epsilon : numpy.ndarray, shape (...,3,3)
Symmetric strain tensor of which the von Mises equivalent is computed.
Returns
-------
epsilon_vM : numpy.ndarray of shape (...)
epsilon_vM : numpy.ndarray, shape (...)
Von Mises equivalent strain of epsilon.
"""
@ -73,12 +73,12 @@ def equivalent_stress_Mises(sigma: _np.ndarray) -> _np.ndarray:
Parameters
----------
sigma : numpy.ndarray of shape (...,3,3)
sigma : numpy.ndarray, shape (...,3,3)
Symmetric stress tensor of which the von Mises equivalent is computed.
Returns
-------
sigma_vM : numpy.ndarray of shape (...)
sigma_vM : numpy.ndarray, shape (...)
Von Mises equivalent stress of sigma.
"""
@ -91,12 +91,12 @@ def maximum_shear(T_sym: _np.ndarray) -> _np.ndarray:
Parameters
----------
T_sym : numpy.ndarray of shape (...,3,3)
T_sym : numpy.ndarray, shape (...,3,3)
Symmetric tensor of which the maximum shear is computed.
Returns
-------
gamma_max : numpy.ndarray of shape (...)
gamma_max : numpy.ndarray, shape (...)
Maximum shear of T_sym.
"""
@ -110,12 +110,12 @@ def rotation(T: _np.ndarray) -> _rotation.Rotation:
Parameters
----------
T : numpy.ndarray of shape (...,3,3)
T : numpy.ndarray, shape (...,3,3)
Tensor of which the rotational part is computed.
Returns
-------
R : damask.Rotation of shape (...)
R : damask.Rotation, shape (...)
Rotational part of the vector.
"""
@ -128,7 +128,7 @@ def strain(F: _np.ndarray, t: str, m: float) -> _np.ndarray:
Parameters
----------
F : numpy.ndarray of shape (...,3,3)
F : numpy.ndarray, shape (...,3,3)
Deformation gradient.
t : {‘V’, ‘U’}
Type of the polar decomposition, ‘V’ for left stretch tensor
@ -138,7 +138,7 @@ def strain(F: _np.ndarray, t: str, m: float) -> _np.ndarray:
Returns
-------
epsilon : numpy.ndarray of shape (...,3,3)
epsilon : numpy.ndarray, shape (...,3,3)
Strain of F.
References
@ -170,14 +170,14 @@ def stress_Cauchy(P: _np.ndarray, F: _np.ndarray) -> _np.ndarray:
Parameters
----------
P : numpy.ndarray of shape (...,3,3)
P : numpy.ndarray, shape (...,3,3)
First Piola-Kirchhoff stress.
F : numpy.ndarray of shape (...,3,3)
F : numpy.ndarray, shape (...,3,3)
Deformation gradient.
Returns
-------
sigma : numpy.ndarray of shape (...,3,3)
sigma : numpy.ndarray, shape (...,3,3)
Cauchy stress.
"""
@ -193,14 +193,14 @@ def stress_second_Piola_Kirchhoff(P: _np.ndarray, F: _np.ndarray) -> _np.ndarray
Parameters
----------
P : numpy.ndarray of shape (...,3,3)
P : numpy.ndarray, shape (...,3,3)
First Piola-Kirchhoff stress.
F : numpy.ndarray of shape (...,3,3)
F : numpy.ndarray, shape (...,3,3)
Deformation gradient.
Returns
-------
S : numpy.ndarray of shape (...,3,3)
S : numpy.ndarray, shape (...,3,3)
Second Piola-Kirchhoff stress.
"""
@ -213,12 +213,12 @@ def stretch_left(T: _np.ndarray) -> _np.ndarray:
Parameters
----------
T : numpy.ndarray of shape (...,3,3)
T : numpy.ndarray, shape (...,3,3)
Tensor of which the left stretch is computed.
Returns
-------
V : numpy.ndarray of shape (...,3,3)
V : numpy.ndarray, shape (...,3,3)
Left stretch tensor from Polar decomposition of T.
"""
@ -231,12 +231,12 @@ def stretch_right(T: _np.ndarray) -> _np.ndarray:
Parameters
----------
T : numpy.ndarray of shape (...,3,3)
T : numpy.ndarray, shape (...,3,3)
Tensor of which the right stretch is computed.
Returns
-------
U : numpy.ndarray of shape (...,3,3)
U : numpy.ndarray, shape (...,3,3)
Left stretch tensor from Polar decomposition of T.
"""
@ -249,7 +249,7 @@ def _polar_decomposition(T: _np.ndarray, requested: Sequence[str]) -> tuple:
Parameters
----------
T : numpy.ndarray of shape (...,3,3)
T : numpy.ndarray, shape (...,3,3)
Tensor of which the singular values are computed.
requested : iterable of str
Requested outputs: ‘R’ for the rotation tensor,
@ -279,7 +279,7 @@ def _equivalent_Mises(T_sym: _np.ndarray, s: float) -> _np.ndarray:
Parameters
----------
T_sym : numpy.ndarray of shape (...,3,3)
T_sym : numpy.ndarray, shape (...,3,3)
Symmetric tensor of which the von Mises equivalent is computed.
s : float
Scaling factor (2/3 for strain, 3/2 for stress).

24
python/damask/tensor.py
View File

@ -14,12 +14,12 @@ def deviatoric(T: _np.ndarray) -> _np.ndarray:
Parameters
----------
T : numpy.ndarray of shape (...,3,3)
T : numpy.ndarray, shape (...,3,3)
Tensor of which the deviatoric part is computed.
Returns
-------
T' : numpy.ndarray of shape (...,3,3)
T' : numpy.ndarray, shape (...,3,3)
Deviatoric part of T.
"""
@ -32,12 +32,12 @@ def eigenvalues(T_sym: _np.ndarray) -> _np.ndarray:
Parameters
----------
T_sym : numpy.ndarray of shape (...,3,3)
T_sym : numpy.ndarray, shape (...,3,3)
Symmetric tensor of which the eigenvalues are computed.
Returns
-------
lambda : numpy.ndarray of shape (...,3)
lambda : numpy.ndarray, shape (...,3)
Eigenvalues of T_sym sorted in ascending order, each repeated
according to its multiplicity.
@ -51,14 +51,14 @@ def eigenvectors(T_sym: _np.ndarray, RHS: bool = False) -> _np.ndarray:
Parameters
----------
T_sym : numpy.ndarray of shape (...,3,3)
T_sym : numpy.ndarray, shape (...,3,3)
Symmetric tensor of which the eigenvectors are computed.
RHS: bool, optional
Enforce right-handed coordinate system. Defaults to False.
Returns
-------
x : numpy.ndarray of shape (...,3,3)
x : numpy.ndarray, shape (...,3,3)
Eigenvectors of T_sym sorted in ascending order of their
associated eigenvalues.
@ -76,14 +76,14 @@ def spherical(T: _np.ndarray, tensor: bool = True) -> _np.ndarray:
Parameters
----------
T : numpy.ndarray of shape (...,3,3)
T : numpy.ndarray, shape (...,3,3)
Tensor of which the spherical part is computed.
tensor : bool, optional
Map spherical part onto identity tensor. Defaults to True.
Returns
-------
p : numpy.ndarray of shape (...,3,3)
p : numpy.ndarray, shape (...,3,3)
unless tensor == False: shape (...,)
Spherical part of tensor T. p is an isotropic tensor.
@ -98,12 +98,12 @@ def symmetric(T: _np.ndarray) -> _np.ndarray:
Parameters
----------
T : numpy.ndarray of shape (...,3,3)
T : numpy.ndarray, shape (...,3,3)
Tensor of which the symmetrized values are computed.
Returns
-------
T_sym : numpy.ndarray of shape (...,3,3)
T_sym : numpy.ndarray, shape (...,3,3)
Symmetrized tensor T.
"""
@ -116,12 +116,12 @@ def transpose(T: _np.ndarray) -> _np.ndarray:
Parameters
----------
T : numpy.ndarray of shape (...,3,3)
T : numpy.ndarray, shape (...,3,3)
Tensor of which the transpose is computed.
Returns
-------
T.T : numpy.ndarray of shape (...,3,3)
T.T : numpy.ndarray, shape (...,3,3)
Transpose of tensor T.
"""

406
src/HDF5_utilities.f90
View File

@ -113,15 +113,15 @@ subroutine HDF5_utilities_init
print'(/,1x,a)', '<<<+- HDF5_Utilities init -+>>>'
call h5open_f(hdferr)
call H5Open_f(hdferr)
if (hdferr < 0) error stop 'HDF5 error'
call h5tget_size_f(H5T_NATIVE_INTEGER,typeSize, hdferr)
call H5Tget_size_f(H5T_NATIVE_INTEGER,typeSize, hdferr)
if (hdferr < 0) error stop 'HDF5 error'
if (int(bit_size(0),SIZE_T)/=typeSize*8) &
error stop 'Default integer size does not match H5T_NATIVE_INTEGER'
call h5tget_size_f(H5T_NATIVE_DOUBLE,typeSize, hdferr)
call H5Tget_size_f(H5T_NATIVE_DOUBLE,typeSize, hdferr)
if (hdferr < 0) error stop 'HDF5 error'
if (int(storage_size(0.0_pReal),SIZE_T)/=typeSize*8) &
error stop 'pReal does not match H5T_NATIVE_DOUBLE'
@ -171,34 +171,34 @@ integer(HID_T) function HDF5_openFile(fileName,mode,parallel)
m = mode
else
m = 'r'
endif
end if
call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdferr)
call H5Pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
#ifdef PETSC
if (present(parallel)) then
if (parallel) call h5pset_fapl_mpio_f(plist_id, PETSC_COMM_WORLD, MPI_INFO_NULL, hdferr)
if (parallel) call H5Pset_fapl_mpio_f(plist_id, PETSC_COMM_WORLD, MPI_INFO_NULL, hdferr)
else
call h5pset_fapl_mpio_f(plist_id, PETSC_COMM_WORLD, MPI_INFO_NULL, hdferr)
endif
call H5Pset_fapl_mpio_f(plist_id, PETSC_COMM_WORLD, MPI_INFO_NULL, hdferr)
end if
if(hdferr < 0) error stop 'HDF5 error'
#endif
if (m == 'w') then
call h5fcreate_f(fileName,H5F_ACC_TRUNC_F,HDF5_openFile,hdferr,access_prp = plist_id)
call H5Fcreate_f(fileName,H5F_ACC_TRUNC_F,HDF5_openFile,hdferr,access_prp = plist_id)
if(hdferr < 0) error stop 'HDF5 error'
elseif(m == 'a') then
call h5fopen_f(fileName,H5F_ACC_RDWR_F,HDF5_openFile,hdferr,access_prp = plist_id)
call H5Fopen_f(fileName,H5F_ACC_RDWR_F,HDF5_openFile,hdferr,access_prp = plist_id)
if(hdferr < 0) error stop 'HDF5 error'
elseif(m == 'r') then
call h5fopen_f(fileName,H5F_ACC_RDONLY_F,HDF5_openFile,hdferr,access_prp = plist_id)
call H5Fopen_f(fileName,H5F_ACC_RDONLY_F,HDF5_openFile,hdferr,access_prp = plist_id)
if(hdferr < 0) error stop 'HDF5 error'
else
error stop 'unknown access mode'
endif
end if
call h5pclose_f(plist_id, hdferr)
call H5Pclose_f(plist_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
end function HDF5_openFile
@ -213,7 +213,7 @@ subroutine HDF5_closeFile(fileHandle)
integer :: hdferr
call h5fclose_f(fileHandle,hdferr)
call H5Fclose_f(fileHandle,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
end subroutine HDF5_closeFile
@ -232,22 +232,22 @@ integer(HID_T) function HDF5_addGroup(fileHandle,groupName)
!-------------------------------------------------------------------------------------------------
! creating a property list for data access properties
call h5pcreate_f(H5P_GROUP_ACCESS_F, aplist_id, hdferr)
call H5Pcreate_f(H5P_GROUP_ACCESS_F, aplist_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
!-------------------------------------------------------------------------------------------------
! setting I/O mode to collective
#ifdef PETSC
call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr)
call H5Pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr)
if(hdferr < 0) error stop 'HDF5 error'
#endif
!-------------------------------------------------------------------------------------------------
! Create group
call h5gcreate_f(fileHandle, trim(groupName), HDF5_addGroup, hdferr, OBJECT_NAMELEN_DEFAULT_F,gapl_id = aplist_id)
call H5Gcreate_f(fileHandle, trim(groupName), HDF5_addGroup, hdferr, OBJECT_NAMELEN_DEFAULT_F,gapl_id = aplist_id)
if(hdferr < 0) error stop 'HDF5 error'
call h5pclose_f(aplist_id,hdferr)
call H5Pclose_f(aplist_id,hdferr)
end function HDF5_addGroup
@ -268,22 +268,22 @@ integer(HID_T) function HDF5_openGroup(fileHandle,groupName)
!-------------------------------------------------------------------------------------------------
! creating a property list for data access properties
call h5pcreate_f(H5P_GROUP_ACCESS_F, aplist_id, hdferr)
call H5Pcreate_f(H5P_GROUP_ACCESS_F, aplist_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
!-------------------------------------------------------------------------------------------------
! setting I/O mode to collective
#ifdef PETSC
call h5pget_all_coll_metadata_ops_f(aplist_id, is_collective, hdferr)
call H5Pget_all_coll_metadata_ops_f(aplist_id, is_collective, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
#endif
!-------------------------------------------------------------------------------------------------
! opening the group
call h5gopen_f(fileHandle, trim(groupName), HDF5_openGroup, hdferr, gapl_id = aplist_id)
call H5Gopen_f(fileHandle, trim(groupName), HDF5_openGroup, hdferr, gapl_id = aplist_id)
if(hdferr < 0) error stop 'HDF5 error'
call h5pclose_f(aplist_id,hdferr)
call H5Pclose_f(aplist_id,hdferr)
end function HDF5_openGroup
@ -297,7 +297,7 @@ subroutine HDF5_closeGroup(group_id)
integer :: hdferr
call h5gclose_f(group_id, hdferr)
call H5Gclose_f(group_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
end subroutine HDF5_closeGroup
@ -319,15 +319,15 @@ logical function HDF5_objectExists(loc_id,path)
p = trim(path)
else
p = '.'
endif
end if
call h5lexists_f(loc_id, p, HDF5_objectExists, hdferr)
call H5Lexists_f(loc_id, p, HDF5_objectExists, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
if(HDF5_objectExists) then
call h5oexists_by_name_f(loc_id, p, HDF5_objectExists, hdferr)
call H5Oexists_by_name_f(loc_id, p, HDF5_objectExists, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
endif
end if
end function HDF5_objectExists
@ -353,29 +353,29 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path)
p = trim(path)
else
p = '.'
endif
end if
attrValue_(1) = trim(attrValue)//C_NULL_CHAR
ptr(1) = c_loc(attrValue_(1))
call h5screate_f(H5S_SCALAR_F,space_id,hdferr)
call H5Screate_f(H5S_SCALAR_F,space_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
call H5Aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
if (attrExists) then
call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
call H5Adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
endif
end if
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_STRING,space_id,attr_id,hdferr)
call H5Acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_STRING,space_id,attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5awrite_f(attr_id, H5T_STRING, c_loc(ptr), hdferr) ! ptr instead of c_loc(ptr) works on gfortran, not on ifort
call H5Awrite_f(attr_id, H5T_STRING, c_loc(ptr), hdferr) ! ptr instead of c_loc(ptr) works on gfortran, not on ifort
if(hdferr < 0) error stop 'HDF5 error'
call h5aclose_f(attr_id,hdferr)
call H5Aclose_f(attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(space_id,hdferr)
call H5Sclose_f(space_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
end subroutine HDF5_addAttribute_str
@ -401,26 +401,26 @@ subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path)
p = trim(path)
else
p = '.'
endif
end if
call h5screate_f(H5S_SCALAR_F,space_id,hdferr)
call H5Screate_f(H5S_SCALAR_F,space_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
call H5Aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
if (attrExists) then
call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
call H5Adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
endif
end if
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_INTEGER,space_id,attr_id,hdferr)
call H5Acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_INTEGER,space_id,attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5awrite_f(attr_id, H5T_NATIVE_INTEGER, attrValue, int([1],HSIZE_T), hdferr)
call H5Awrite_f(attr_id, H5T_NATIVE_INTEGER, attrValue, int([1],HSIZE_T), hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5aclose_f(attr_id,hdferr)
call H5Aclose_f(attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(space_id,hdferr)
call H5Sclose_f(space_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
end subroutine HDF5_addAttribute_int
@ -446,26 +446,26 @@ subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path)
p = trim(path)
else
p = '.'
endif
end if
call h5screate_f(H5S_SCALAR_F,space_id,hdferr)
call H5Screate_f(H5S_SCALAR_F,space_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
call H5Aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
if (attrExists) then
call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
call H5Adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
endif
end if
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_DOUBLE,space_id,attr_id,hdferr)
call H5Acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_DOUBLE,space_id,attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5awrite_f(attr_id, H5T_NATIVE_DOUBLE, attrValue, int([1],HSIZE_T), hdferr)
call H5Awrite_f(attr_id, H5T_NATIVE_DOUBLE, attrValue, int([1],HSIZE_T), hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5aclose_f(attr_id,hdferr)
call H5Aclose_f(attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(space_id,hdferr)
call H5Sclose_f(space_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
end subroutine HDF5_addAttribute_real
@ -493,31 +493,31 @@ subroutine HDF5_addAttribute_str_array(loc_id,attrLabel,attrValue,path)
p = trim(path)
else
p = '.'
endif
end if
do i=1,size(attrValue)
attrValue_(i) = attrValue(i)//C_NULL_CHAR
ptr(i) = c_loc(attrValue_(i))
enddo
call h5screate_simple_f(1,shape(attrValue_,kind=HSIZE_T),space_id,hdferr,shape(attrValue_,kind=HSIZE_T))
call H5Screate_simple_f(1,shape(attrValue_,kind=HSIZE_T),space_id,hdferr,shape(attrValue_,kind=HSIZE_T))
if(hdferr < 0) error stop 'HDF5 error'
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
call H5Aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
if (attrExists) then
call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
call H5Adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
endif
end if
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_STRING,space_id,attr_id,hdferr)
call H5Acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_STRING,space_id,attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5awrite_f(attr_id, H5T_STRING, c_loc(ptr), hdferr) ! ptr instead of c_loc(ptr) works on gfortran, not on ifort
call H5Awrite_f(attr_id, H5T_STRING, c_loc(ptr), hdferr) ! ptr instead of c_loc(ptr) works on gfortran, not on ifort
if(hdferr < 0) error stop 'HDF5 error'
call h5aclose_f(attr_id,hdferr)
call H5Aclose_f(attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(space_id,hdferr)
call H5Sclose_f(space_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
end subroutine HDF5_addAttribute_str_array
@ -544,28 +544,28 @@ subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path)
p = trim(path)
else
p = '.'
endif
end if
array_size = size(attrValue,kind=HSIZE_T)
call h5screate_simple_f(1, array_size, space_id, hdferr, array_size)
call H5Screate_simple_f(1, array_size, space_id, hdferr, array_size)
if(hdferr < 0) error stop 'HDF5 error'
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
call H5Aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
if (attrExists) then
call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
call H5Adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
endif
end if
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_INTEGER,space_id,attr_id,hdferr)
call H5Acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_INTEGER,space_id,attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5awrite_f(attr_id, H5T_NATIVE_INTEGER, attrValue, array_size, hdferr)
call H5Awrite_f(attr_id, H5T_NATIVE_INTEGER, attrValue, array_size, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5aclose_f(attr_id,hdferr)
call H5Aclose_f(attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(space_id,hdferr)
call H5Sclose_f(space_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
end subroutine HDF5_addAttribute_int_array
@ -592,28 +592,28 @@ subroutine HDF5_addAttribute_real_array(loc_id,attrLabel,attrValue,path)
p = trim(path)
else
p = '.'
endif
end if
array_size = size(attrValue,kind=HSIZE_T)
call h5screate_simple_f(1, array_size, space_id, hdferr, array_size)
call H5Screate_simple_f(1, array_size, space_id, hdferr, array_size)
if(hdferr < 0) error stop 'HDF5 error'
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
call H5Aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
if (attrExists) then
call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
call H5Adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
endif
end if
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_DOUBLE,space_id,attr_id,hdferr)
call H5Acreate_by_name_f(loc_id,trim(p),trim(attrLabel),H5T_NATIVE_DOUBLE,space_id,attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5awrite_f(attr_id, H5T_NATIVE_DOUBLE, attrValue, array_size, hdferr)
call H5Awrite_f(attr_id, H5T_NATIVE_DOUBLE, attrValue, array_size, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5aclose_f(attr_id,hdferr)
call H5Aclose_f(attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(space_id,hdferr)
call H5Sclose_f(space_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
end subroutine HDF5_addAttribute_real_array
@ -629,13 +629,13 @@ subroutine HDF5_setLink(loc_id,target_name,link_name)
integer :: hdferr
logical :: linkExists
call h5lexists_f(loc_id, link_name,linkExists, hdferr)
call H5Lexists_f(loc_id, link_name,linkExists, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
if (linkExists) then
call h5ldelete_f(loc_id,link_name, hdferr)
call H5Ldelete_f(loc_id,link_name, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
endif
call h5lcreate_soft_f(target_name, loc_id, link_name, hdferr)
end if
call H5Lcreate_soft_f(target_name, loc_id, link_name, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
end subroutine HDF5_setLink
@ -671,9 +671,9 @@ subroutine HDF5_read_real1(dataset,loc_id,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif
end if
call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if(hdferr < 0) error stop 'HDF5 error'
@ -711,9 +711,9 @@ subroutine HDF5_read_real2(dataset,loc_id,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif
end if
call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if(hdferr < 0) error stop 'HDF5 error'
@ -751,9 +751,9 @@ subroutine HDF5_read_real3(dataset,loc_id,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif
end if
call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if(hdferr < 0) error stop 'HDF5 error'
@ -791,9 +791,9 @@ subroutine HDF5_read_real4(dataset,loc_id,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif
end if
call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if(hdferr < 0) error stop 'HDF5 error'
@ -831,9 +831,9 @@ subroutine HDF5_read_real5(dataset,loc_id,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif
end if
call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if(hdferr < 0) error stop 'HDF5 error'
@ -871,9 +871,9 @@ subroutine HDF5_read_real6(dataset,loc_id,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif
end if
call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if(hdferr < 0) error stop 'HDF5 error'
@ -911,9 +911,9 @@ subroutine HDF5_read_real7(dataset,loc_id,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif
end if
call h5dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if(hdferr < 0) error stop 'HDF5 error'
@ -953,9 +953,9 @@ subroutine HDF5_read_int1(dataset,loc_id,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif
end if
call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if(hdferr < 0) error stop 'HDF5 error'
@ -993,9 +993,9 @@ subroutine HDF5_read_int2(dataset,loc_id,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif
end if
call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if(hdferr < 0) error stop 'HDF5 error'
@ -1033,9 +1033,9 @@ subroutine HDF5_read_int3(dataset,loc_id,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif
end if
call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if(hdferr < 0) error stop 'HDF5 error'
@ -1073,9 +1073,9 @@ subroutine HDF5_read_int4(dataset,loc_id,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif
end if
call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if(hdferr < 0) error stop 'HDF5 error'
@ -1113,9 +1113,9 @@ subroutine HDF5_read_int5(dataset,loc_id,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif
end if
call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if(hdferr < 0) error stop 'HDF5 error'
@ -1153,9 +1153,9 @@ subroutine HDF5_read_int6(dataset,loc_id,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif
end if
call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if(hdferr < 0) error stop 'HDF5 error'
@ -1193,9 +1193,9 @@ subroutine HDF5_read_int7(dataset,loc_id,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
endif
end if
call h5dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
file_space_id = filespace_id, xfer_prp = plist_id, mem_space_id = memspace_id)
if(hdferr < 0) error stop 'HDF5 error'
@ -1233,13 +1233,13 @@ subroutine HDF5_write_real1(dataset,loc_id,datasetName,parallel)
else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape,loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default)
endif
end if
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
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)
if(hdferr < 0) error stop 'HDF5 error'
endif
end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1274,13 +1274,13 @@ subroutine HDF5_write_real2(dataset,loc_id,datasetName,parallel)
else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default)
endif
end if
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
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)
if(hdferr < 0) error stop 'HDF5 error'
endif
end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1315,13 +1315,13 @@ subroutine HDF5_write_real3(dataset,loc_id,datasetName,parallel)
else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default)
endif
end if
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
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)
if(hdferr < 0) error stop 'HDF5 error'
endif
end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1356,13 +1356,13 @@ subroutine HDF5_write_real4(dataset,loc_id,datasetName,parallel)
else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default)
endif
end if
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
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)
if(hdferr < 0) error stop 'HDF5 error'
endif
end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1398,13 +1398,13 @@ subroutine HDF5_write_real5(dataset,loc_id,datasetName,parallel)
else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default)
endif
end if
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
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)
if(hdferr < 0) error stop 'HDF5 error'
endif
end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1439,13 +1439,13 @@ subroutine HDF5_write_real6(dataset,loc_id,datasetName,parallel)
else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default)
endif
end if
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
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)
if(hdferr < 0) error stop 'HDF5 error'
endif
end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1480,13 +1480,13 @@ subroutine HDF5_write_real7(dataset,loc_id,datasetName,parallel)
else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE,parallel_default)
endif
end if
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
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)
if(hdferr < 0) error stop 'HDF5 error'
endif
end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1510,9 +1510,9 @@ subroutine HDF5_write_str(dataset,loc_id,datasetName)
dataset_ = trim(dataset)
call h5tcopy_f(H5T_C_S1, filetype_id, hdferr)
call H5Tcopy_f(H5T_C_S1, filetype_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5tset_size_f(filetype_id, int(len(dataset_)+1,HSIZE_T), hdferr) ! +1 for NULL
call H5Tset_size_f(filetype_id, int(len(dataset_)+1,HSIZE_T), hdferr) ! +1 for NULL
if(hdferr < 0) error stop 'HDF5 error'
call H5Tcopy_f(H5T_FORTRAN_S1, memtype_id, hdferr)
@ -1520,36 +1520,36 @@ subroutine HDF5_write_str(dataset,loc_id,datasetName)
call H5Tset_size_f(memtype_id, int(len(dataset_),HSIZE_T), hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5pcreate_f(H5P_DATASET_CREATE_F, dcpl, hdferr)
call H5Pcreate_f(H5P_DATASET_CREATE_F, dcpl, hdferr)
if (hdferr < 0) error stop 'HDF5 error'
call h5pset_chunk_f(dcpl, 1, [1_HSIZE_T], hdferr)
call H5Pset_chunk_f(dcpl, 1, [1_HSIZE_T], hdferr)
if (hdferr < 0) error stop 'HDF5 error'
call h5pset_Fletcher32_f(dcpl,hdferr)
call H5Pset_Fletcher32_f(dcpl,hdferr)
if (hdferr < 0) error stop 'HDF5 error'
if (compression_possible .and. len(dataset) > 1024*256) then
call h5pset_shuffle_f(dcpl, hdferr)
call H5Pset_shuffle_f(dcpl, hdferr)
if (hdferr < 0) error stop 'HDF5 error'
call h5pset_deflate_f(dcpl, 6, hdferr)
call H5Pset_deflate_f(dcpl, 6, hdferr)
if (hdferr < 0) error stop 'HDF5 error'
endif
end if
call h5screate_simple_f(1, [1_HSIZE_T], space_id, hdferr)
call H5Screate_simple_f(1, [1_HSIZE_T], space_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
CALL h5dcreate_f(loc_id, datasetName, filetype_id, space_id, dataset_id, hdferr, dcpl)
CALL H5Dcreate_f(loc_id, datasetName, filetype_id, space_id, dataset_id, hdferr, dcpl)
if(hdferr < 0) error stop 'HDF5 error'
call h5dwrite_f(dataset_id, memtype_id, c_loc(dataset_(1:1)), hdferr)
call H5Dwrite_f(dataset_id, memtype_id, c_loc(dataset_(1:1)), hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5pclose_f(dcpl, hdferr)
call H5Pclose_f(dcpl, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5dclose_f(dataset_id, hdferr)
call H5Dclose_f(dataset_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(space_id, hdferr)
call H5Sclose_f(space_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5tclose_f(memtype_id, hdferr)
call H5Tclose_f(memtype_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5tclose_f(filetype_id, hdferr)
call H5Tclose_f(filetype_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
end subroutine HDF5_write_str
@ -1584,13 +1584,13 @@ subroutine HDF5_write_int1(dataset,loc_id,datasetName,parallel)
else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default)
endif
end if
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
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)
if(hdferr < 0) error stop 'HDF5 error'
endif
end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1625,13 +1625,13 @@ subroutine HDF5_write_int2(dataset,loc_id,datasetName,parallel)
else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default)
endif
end if
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
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)
if(hdferr < 0) error stop 'HDF5 error'
endif
end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1666,13 +1666,13 @@ subroutine HDF5_write_int3(dataset,loc_id,datasetName,parallel)
else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default)
endif
end if
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
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)
if(hdferr < 0) error stop 'HDF5 error'
endif
end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1707,13 +1707,13 @@ subroutine HDF5_write_int4(dataset,loc_id,datasetName,parallel)
else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default)
endif
end if
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
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)
if(hdferr < 0) error stop 'HDF5 error'
endif
end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1748,13 +1748,13 @@ subroutine HDF5_write_int5(dataset,loc_id,datasetName,parallel)
else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default)
endif
end if
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
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)
if(hdferr < 0) error stop 'HDF5 error'
endif
end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1789,13 +1789,13 @@ subroutine HDF5_write_int6(dataset,loc_id,datasetName,parallel)
else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default)
endif
end if
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
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)
if(hdferr < 0) error stop 'HDF5 error'
endif
end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1830,13 +1830,13 @@ subroutine HDF5_write_int7(dataset,loc_id,datasetName,parallel)
else
call initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
myStart, totalShape, loc_id,myShape,datasetName,H5T_NATIVE_INTEGER,parallel_default)
endif
end if
if (product(totalShape) /= 0) then
call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
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)
if(hdferr < 0) error stop 'HDF5 error'
endif
end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1867,7 +1867,7 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_
!-------------------------------------------------------------------------------------------------
! creating a property list for transfer properties (is collective for MPI)
call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
call H5Pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
!--------------------------------------------------------------------------------------------------
@ -1875,11 +1875,11 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_
readSize(worldrank+1) = int(localShape(ubound(localShape,1)))
#ifdef PETSC
if (parallel) then
call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
call H5Pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call MPI_allreduce(MPI_IN_PLACE,readSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process
if (ierr /= 0) error stop 'MPI error'
endif
end if
#endif
myStart = int(0,HSIZE_T)
myStart(ubound(myStart)) = int(sum(readSize(1:worldrank)),HSIZE_T)
@ -1887,28 +1887,28 @@ subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_
!--------------------------------------------------------------------------------------------------
! create dataspace in memory (local shape)
call h5screate_simple_f(size(localShape), localShape, memspace_id, hdferr, localShape)
call H5Screate_simple_f(size(localShape), localShape, memspace_id, hdferr, localShape)
if(hdferr < 0) error stop 'HDF5 error'
!--------------------------------------------------------------------------------------------------
! creating a property list for IO and set it to collective
call h5pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr)
call H5Pcreate_f(H5P_DATASET_ACCESS_F, aplist_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
#ifdef PETSC
call h5pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr)
call H5Pset_all_coll_metadata_ops_f(aplist_id, .true., hdferr)
if(hdferr < 0) error stop 'HDF5 error'
#endif
!--------------------------------------------------------------------------------------------------
! open the dataset in the file and get the space ID
call h5dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id)
call H5Dopen_f(loc_id,datasetName,dset_id,hdferr, dapl_id = aplist_id)
if(hdferr < 0) error stop 'HDF5 error'
call h5dget_space_f(dset_id, filespace_id, hdferr)
call H5Dget_space_f(dset_id, filespace_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
!--------------------------------------------------------------------------------------------------
! select a hyperslab (the portion of the current process) in the file
call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, localShape, hdferr)
call H5Sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, localShape, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
end subroutine initialize_read
@ -1922,15 +1922,15 @@ subroutine finalize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HID_T), intent(in) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer :: hdferr
call h5pclose_f(plist_id, hdferr)
call H5Pclose_f(plist_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5pclose_f(aplist_id, hdferr)
call H5Pclose_f(aplist_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5dclose_f(dset_id, hdferr)
call H5Dclose_f(dset_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(filespace_id, hdferr)
call H5Sclose_f(filespace_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(memspace_id, hdferr)
call H5Sclose_f(memspace_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
end subroutine finalize_read
@ -1962,13 +1962,13 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
!-------------------------------------------------------------------------------------------------
! creating a property list for transfer properties (is collective when writing in parallel)
call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
call H5Pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
#ifdef PETSC
if (parallel) then
call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
call H5Pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
endif
end if
#endif
!--------------------------------------------------------------------------------------------------
@ -1987,43 +1987,43 @@ subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
!--------------------------------------------------------------------------------------------------
! chunk dataset, enable compression for larger datasets
call h5pcreate_f(H5P_DATASET_CREATE_F, dcpl, hdferr)
call H5Pcreate_f(H5P_DATASET_CREATE_F, dcpl, hdferr)
if (hdferr < 0) error stop 'HDF5 error'
if (product(totalShape) > 0) then
call h5pset_Fletcher32_f(dcpl,hdferr)
call H5Pset_Fletcher32_f(dcpl,hdferr)
if (hdferr < 0) error stop 'HDF5 error'
if (product(totalShape) >= chunkSize*2_HSIZE_T) then
call h5pset_chunk_f(dcpl, size(totalShape), getChunks(totalShape,chunkSize), hdferr)
call H5Pset_chunk_f(dcpl, size(totalShape), getChunks(totalShape,chunkSize), hdferr)
if (hdferr < 0) error stop 'HDF5 error'
if (compression_possible) then
call h5pset_shuffle_f(dcpl, hdferr)
call H5Pset_shuffle_f(dcpl, hdferr)
if (hdferr < 0) error stop 'HDF5 error'
call h5pset_deflate_f(dcpl, 6, hdferr)
call H5Pset_deflate_f(dcpl, 6, hdferr)
if (hdferr < 0) error stop 'HDF5 error'
end if
else
call h5pset_chunk_f(dcpl, size(totalShape), totalShape, hdferr)
call H5Pset_chunk_f(dcpl, size(totalShape), totalShape, hdferr)
if (hdferr < 0) error stop 'HDF5 error'
end if
end if
!--------------------------------------------------------------------------------------------------
! create dataspace in memory (local shape) and in file (global shape)
call h5screate_simple_f(size(myShape), myShape, memspace_id, hdferr, myShape)
call H5Screate_simple_f(size(myShape), myShape, memspace_id, hdferr, myShape)
if(hdferr < 0) error stop 'HDF5 error'
call h5screate_simple_f(size(totalShape), totalShape, filespace_id, hdferr, totalShape)
call H5Screate_simple_f(size(totalShape), totalShape, filespace_id, hdferr, totalShape)
if(hdferr < 0) error stop 'HDF5 error'
!--------------------------------------------------------------------------------------------------
! create dataset in the file and select a hyperslab from it (the portion of the current process)
call h5dcreate_f(loc_id, trim(datasetName), datatype, filespace_id, dset_id, hdferr, dcpl)
call H5Dcreate_f(loc_id, trim(datasetName), datatype, filespace_id, dset_id, hdferr, dcpl)
if(hdferr < 0) error stop 'HDF5 error'
call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, myShape, hdferr)
call H5Sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myStart, myShape, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5pclose_f(dcpl , hdferr)
call H5Pclose_f(dcpl , hdferr)
if(hdferr < 0) error stop 'HDF5 error'
contains
@ -2052,13 +2052,13 @@ subroutine finalize_write(plist_id, dset_id, filespace_id, memspace_id)
integer(HID_T), intent(in) :: dset_id, filespace_id, memspace_id, plist_id
integer :: hdferr
call h5pclose_f(plist_id, hdferr)
call H5Pclose_f(plist_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5dclose_f(dset_id, hdferr)
call H5Dclose_f(dset_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(filespace_id, hdferr)
call H5Sclose_f(filespace_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(memspace_id, hdferr)
call H5Sclose_f(memspace_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
end subroutine finalize_write

50
src/YAML_parse.f90
View File

@ -101,9 +101,9 @@ recursive function parse_flow(YAML_flow) result(node)
node = trim(adjustl(flow_string(2:len(flow_string)-1)))
else
node = trim(adjustl(flow_string))
endif
end if
end select
endif
end if
end function parse_flow
@ -150,7 +150,7 @@ logical function quotedString(line)
if (scan(line(:1),IO_QUOTES) == 1) then
quotedString = .true.
if(line(len(line):len(line)) /= line(:1)) call IO_error(710,ext_msg=line)
endif
end if
end function quotedString
@ -209,7 +209,7 @@ logical function isListItem(line)
isListItem = scan(trim(adjustl(line)),' ') == 2
else
isListItem = trim(adjustl(line)) == '-'
endif
end if
end function isListItem
@ -224,7 +224,7 @@ logical function isKeyValue(line)
if( .not. isKey(line) .and. index(IO_rmComment(line),':') > 0 .and. .not. isFlow(line)) then
if(index(IO_rmComment(line),': ') > 0) isKeyValue = .true.
endif
end if
end function isKeyValue
@ -243,7 +243,7 @@ logical function isKey(line)
isKey = index(IO_rmComment(line),':',back=.false.) == len(IO_rmComment(line)) .and. &
index(IO_rmComment(line),':',back=.true.) == len(IO_rmComment(line)) .and. &
.not. isFlow(line)
endif
end if
end function isKey
@ -299,8 +299,8 @@ subroutine skip_file_header(blck,s_blck)
s_blck = s_blck + index(blck(s_blck:),IO_EOL)
else
call IO_error(708,ext_msg = line)
endif
endif
end if
end if
end subroutine skip_file_header
@ -419,7 +419,7 @@ recursive subroutine line_isFlow(flow,s_flow,line)
call line_isFlow(flow,s_flow,line(s+1:list_chunk-1))
else
call line_toFlow(flow,s_flow,line(s+1:list_chunk-1))
endif
end if
flow(s_flow:s_flow+1) = ', '
s_flow = s_flow +2
s = s + find_end(line(s+1:),']')
@ -447,7 +447,7 @@ recursive subroutine line_isFlow(flow,s_flow,line)
s_flow = s_flow +1
else
call line_toFlow(flow,s_flow,line)
endif
end if
end subroutine line_isFlow
@ -479,7 +479,7 @@ recursive subroutine keyValue_toFlow(flow,s_flow,line)
offset_value = indentDepth(line(col_pos+2:))
line_asStandard = line(:col_pos+1)//line(col_pos+2+offset_value:)
call line_toFlow(flow,s_flow,line_asStandard)
endif
end if
end subroutine keyValue_toFlow
@ -557,10 +557,10 @@ recursive subroutine lst(blck,flow,s_blck,s_flow,offset)
call remove_line_break(blck,s_blck,']',flow_line)
else
call remove_line_break(blck,s_blck,'}',flow_line)
endif
end if
call line_isFlow(flow,s_flow,flow_line)
offset = 0
endif
end if
else ! list item in the same line
line = line(indentDepth(line)+3:)
if(isScalar(line)) then
@ -573,20 +573,20 @@ recursive subroutine lst(blck,flow,s_blck,s_flow,offset)
call remove_line_break(blck,s_blck,']',flow_line)
else
call remove_line_break(blck,s_blck,'}',flow_line)
endif
end if
call line_isFlow(flow,s_flow,flow_line)
offset = 0
else ! non scalar list item
offset = offset + indentDepth(blck(s_blck:))+1 ! offset in spaces to be ignored
s_blck = s_blck + index(blck(s_blck:e_blck),'-') ! s_blck after '-' symbol
endif
end if
end if
end if
if(isScalar(line) .or. isFlow(line)) then
flow(s_flow:s_flow+1) = ', '
s_flow = s_flow + 2
endif
end if
enddo
@ -643,7 +643,7 @@ recursive subroutine dct(blck,flow,s_blck,s_flow,offset)
if(previous_isKey) then
flow(s_flow-1:s_flow) = ', '
s_flow = s_flow + 1
endif
end if
if(isKeyValue(line)) then
col_pos = index(line,':')
@ -652,16 +652,16 @@ recursive subroutine dct(blck,flow,s_blck,s_flow,offset)
call remove_line_break(blck,s_blck,']',flow_line)
else
call remove_line_break(blck,s_blck,'}',flow_line)
endif
end if
call keyValue_toFlow(flow,s_flow,flow_line)
else
call keyValue_toFlow(flow,s_flow,line)
s_blck = e_blck + 2
endif
end if
else
call line_toFlow(flow,s_flow,line)
s_blck = e_blck + 2
endif
end if
end if
if(isScalar(line) .or. isKeyValue(line)) then
@ -670,7 +670,7 @@ recursive subroutine dct(blck,flow,s_blck,s_flow,offset)
previous_isKey = .false.
else
previous_isKey = .true.
endif
end if
flow(s_flow:s_flow) = ' '
s_flow = s_flow + 1
@ -722,14 +722,14 @@ recursive subroutine decide(blck,flow,s_blck,s_flow,offset)
call remove_line_break(blck,s_blck,']',flow_line)
else
call remove_line_break(blck,s_blck,'}',flow_line)
endif
end if
call line_isFlow(flow,s_flow,line)
else
line = line(indentDepth(line)+1:)
call line_toFlow(flow,s_flow,line)
s_blck = e_blck +2
endif
endif
end if
end if
end subroutine
@ -759,7 +759,7 @@ function to_flow(blck)
line = IO_rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))
if(trim(line) == '---') s_blck = s_blck + index(blck(s_blck:),IO_EOL)
call decide(blck,to_flow,s_blck,s_flow,offset)
endif
end if
line = IO_rmComment(blck(s_blck:s_blck+index(blck(s_blck:),IO_EOL)-2))
if(trim(line)== '---') call IO_warning(709,ext_msg=line)
to_flow = trim(to_flow(:s_flow-1))

36
src/YAML_types.f90
View File

@ -646,7 +646,7 @@ function tNode_contains(self,k) result(exists)
if (dict%getKey(j) == k) then
exists = .true.
return
endif
end if
enddo
class is(tList)
list => self%asList()
@ -654,7 +654,7 @@ function tNode_contains(self,k) result(exists)
if (list%get_asString(j) == k) then
exists = .true.
return
endif
end if
enddo
class default
call IO_error(706,ext_msg='Expected list or dict')
@ -694,7 +694,7 @@ function tNode_get_byKey(self,k,defaultVal) result(node)
if (item%key == k) then
found = .true.
exit
endif
end if
item => item%next
j = j + 1
enddo
@ -703,7 +703,7 @@ function tNode_get_byKey(self,k,defaultVal) result(node)
call IO_error(143,ext_msg=k)
else
if (associated(item)) node => item%node
endif
end if
end function tNode_get_byKey
@ -734,7 +734,7 @@ function tNode_get_byKey_asFloat(self,k,defaultVal) result(nodeAsFloat)
nodeAsFloat = defaultVal
else
call IO_error(143,ext_msg=k)
endif
end if
end function tNode_get_byKey_asFloat
@ -765,7 +765,7 @@ function tNode_get_byKey_asInt(self,k,defaultVal) result(nodeAsInt)
nodeAsInt = defaultVal
else
call IO_error(143,ext_msg=k)
endif
end if
end function tNode_get_byKey_asInt
@ -796,7 +796,7 @@ function tNode_get_byKey_asBool(self,k,defaultVal) result(nodeAsBool)
nodeAsBool = defaultVal
else
call IO_error(143,ext_msg=k)
endif
end if
end function tNode_get_byKey_asBool
@ -827,7 +827,7 @@ function tNode_get_byKey_asString(self,k,defaultVal) result(nodeAsString)
nodeAsString = defaultVal
else
call IO_error(143,ext_msg=k)
endif
end if
end function tNode_get_byKey_asString
@ -860,11 +860,11 @@ function tNode_get_byKey_as1dFloat(self,k,defaultVal,requiredSize) result(nodeAs
nodeAs1dFloat = defaultVal
else
call IO_error(143,ext_msg=k)
endif
end if
if (present(requiredSize)) then
if (requiredSize /= size(nodeAs1dFloat)) call IO_error(146,ext_msg=k)
endif
end if
end function tNode_get_byKey_as1dFloat
@ -897,11 +897,11 @@ function tNode_get_byKey_as2dFloat(self,k,defaultVal,requiredShape) result(nodeA
nodeAs2dFloat = defaultVal
else
call IO_error(143,ext_msg=k)
endif
end if
if (present(requiredShape)) then
if (any(requiredShape /= shape(nodeAs2dFloat))) call IO_error(146,ext_msg=k)
endif
end if
end function tNode_get_byKey_as2dFloat
@ -933,11 +933,11 @@ function tNode_get_byKey_as1dInt(self,k,defaultVal,requiredSize) result(nodeAs1d
nodeAs1dInt = defaultVal
else
call IO_error(143,ext_msg=k)
endif
end if
if (present(requiredSize)) then
if (requiredSize /= size(nodeAs1dInt)) call IO_error(146,ext_msg=k)
endif
end if
end function tNode_get_byKey_as1dInt
@ -968,7 +968,7 @@ function tNode_get_byKey_as1dBool(self,k,defaultVal) result(nodeAs1dBool)
nodeAs1dBool = defaultVal
else
call IO_error(143,ext_msg=k)
endif
end if
end function tNode_get_byKey_as1dBool
@ -999,7 +999,7 @@ function tNode_get_byKey_as1dString(self,k,defaultVal) result(nodeAs1dString)
nodeAs1dString = defaultVal
else
call IO_error(143,ext_msg=k)
endif
end if
end function tNode_get_byKey_as1dString
@ -1080,7 +1080,7 @@ recursive function tList_asFormattedString(self,indent) result(str)
indent_ = indent
else
indent_ = 0
endif
end if
item => self%first
do i = 1, self%length
@ -1109,7 +1109,7 @@ recursive function tDict_asFormattedString(self,indent) result(str)
indent_ = indent
else
indent_ = 0
endif
end if
item => self%first
do i = 1, self%length

10
src/grid/spectral_utilities.f90
View File

@ -540,19 +540,19 @@ end subroutine utilities_fourierGammaConvolution
!--------------------------------------------------------------------------------------------------
!> @brief doing convolution DamageGreenOp_hat * field_real
!--------------------------------------------------------------------------------------------------
subroutine utilities_fourierGreenConvolution(D_ref, mobility_ref, deltaT)
subroutine utilities_fourierGreenConvolution(D_ref, mu_ref, Delta_t)
real(pReal), dimension(3,3), intent(in) :: D_ref
real(pReal), intent(in) :: mobility_ref, deltaT
real(pReal), intent(in) :: mu_ref, Delta_t
complex(pReal) :: GreenOp_hat
integer :: i, j, k
!--------------------------------------------------------------------------------------------------
! do the actual spectral method calculation
do k = 1, grid3; do j = 1, grid(2) ;do i = 1, grid1Red
GreenOp_hat = cmplx(1.0_pReal,0.0_pReal,pReal)/ &
(cmplx(mobility_ref,0.0_pReal,pReal) + cmplx(deltaT,0.0_pReal)*&
sum(conjg(xi1st(1:3,i,j,k))* matmul(cmplx(D_ref,0.0_pReal),xi1st(1:3,i,j,k))))
GreenOp_hat = cmplx(1.0_pReal,0.0_pReal,pReal) &
/ (cmplx(mu_ref,0.0_pReal,pReal) + cmplx(Delta_t,0.0_pReal) &
* sum(conjg(xi1st(1:3,i,j,k))* matmul(cmplx(D_ref,0.0_pReal),xi1st(1:3,i,j,k))))
scalarField_fourier(i,j,k) = scalarField_fourier(i,j,k)*GreenOp_hat
enddo; enddo; enddo

8
src/phase_damage_isobrittle.f90
View File

@ -96,7 +96,6 @@ end function isobrittle_init
!--------------------------------------------------------------------------------------------------
!> @brief calculates derived quantities from state
! ToDo: Use Voigt directly
!--------------------------------------------------------------------------------------------------
module subroutine isobrittle_deltaState(C, Fe, ph,en)
@ -110,16 +109,13 @@ module subroutine isobrittle_deltaState(C, Fe, ph,en)
epsilon
real(pReal) :: &
r_W
real(pReal), dimension(6,6) :: &
C_sym
C_sym = math_sym3333to66(math_Voigt66to3333(C))
epsilon = 0.5_pReal*math_sym33to6(matmul(transpose(Fe),Fe)-math_I3)
epsilon = math_33toVoigt6_strain(matmul(transpose(Fe),Fe)-math_I3)
associate(prm => param(ph), stt => state(ph), dlt => deltaState(ph))
r_W = 2.0_pReal*dot_product(epsilon,matmul(C_sym,epsilon))/prm%W_crit
r_W = (0.5_pReal*dot_product(epsilon,matmul(C,epsilon)))/prm%W_crit
dlt%r_W(en) = merge(r_W - stt%r_W(en), 0.0_pReal, r_W > stt%r_W(en))
end associate