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

Resolve "function to handle default of optional arguments"

This commit is contained in:
Martin Diehl 2023-02-18 20:30:57 +00:00 committed by Philip Eisenlohr
parent f3aafb0911
commit 8f3d9a9183
8 changed files with 334 additions and 481 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

433
src/HDF5_utilities.f90
View File

@ -3,6 +3,7 @@
!> @author Yi-Chin Yang, Max-Planck-Institut für Eisenforschung GmbH
!> @author Jennifer Nastola, Max-Planck-Institut für Eisenforschung GmbH
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Michigan State University
!--------------------------------------------------------------------------------------------------
module HDF5_utilities
use HDF5
@ -17,6 +18,7 @@ module HDF5_utilities
use prec
use parallelization
use misc
#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY)
implicit none(type,external)
@ -26,7 +28,7 @@ module HDF5_utilities
private
!--------------------------------------------------------------------------------------------------
!> @brief reads integer or float data of defined shape from file
!> @brief Read integer or float data of defined shape from file.
!> @details for parallel IO, all dimension except for the last need to match
!--------------------------------------------------------------------------------------------------
interface HDF5_read
@ -48,7 +50,7 @@ module HDF5_utilities
end interface HDF5_read
!--------------------------------------------------------------------------------------------------
!> @brief writes integer or real data of defined shape to file
!> @brief Write integer or real data of defined shape to file.
!> @details for parallel IO, all dimension except for the last need to match
!--------------------------------------------------------------------------------------------------
interface HDF5_write
@ -74,7 +76,7 @@ module HDF5_utilities
end interface HDF5_write
!--------------------------------------------------------------------------------------------------
!> @brief attached attributes of type char, integer or real to a file/dataset/group
!> @brief Attach attribute of type char, integer, or real to a file/dataset/group.
!--------------------------------------------------------------------------------------------------
interface HDF5_addAttribute
module procedure HDF5_addAttribute_str
@ -110,7 +112,7 @@ contains
!--------------------------------------------------------------------------------------------------
!> @brief initialize HDF5 libary and do sanity checks
!> @brief Initialize HDF5 libary and perform sanity checks.
!--------------------------------------------------------------------------------------------------
subroutine HDF5_utilities_init
@ -176,31 +178,22 @@ integer(HID_T) function HDF5_openFile(fileName,mode,parallel)
integer :: hdferr
if (present(mode)) then
m = mode
else
m = 'r'
end if
m = misc_optional(mode,'r')
call H5Pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdferr)
if (hdferr < 0) error stop 'HDF5 error'
#ifdef PETSC
if (present(parallel)) then
if (misc_optional(parallel,.true.)) &
#if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY)
if (parallel) call H5Pset_fapl_mpio_f(plist_id, PETSC_COMM_WORLD, MPI_INFO_NULL_F90, hdferr)
else
call H5Pset_fapl_mpio_f(plist_id, PETSC_COMM_WORLD, MPI_INFO_NULL_F90, hdferr)
#else
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)
call H5Pset_fapl_mpio_f(plist_id, PETSC_COMM_WORLD, MPI_INFO_NULL, hdferr)
#endif
end if
if (hdferr < 0) error stop 'HDF5 error'
#endif
if (m == 'w') then
if (m == 'w') then
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
@ -220,7 +213,7 @@ end function HDF5_openFile
!--------------------------------------------------------------------------------------------------
!> @brief close the opened HDF5 output file
!> @brief Close an open HDF5 file.
!--------------------------------------------------------------------------------------------------
subroutine HDF5_closeFile(fileHandle)
@ -235,7 +228,7 @@ end subroutine HDF5_closeFile
!--------------------------------------------------------------------------------------------------
!> @brief adds a new group to the fileHandle
!> @brief Add a new group to the file.
!--------------------------------------------------------------------------------------------------
integer(HID_T) function HDF5_addGroup(fileHandle,groupName)
@ -268,7 +261,7 @@ end function HDF5_addGroup
!--------------------------------------------------------------------------------------------------
!> @brief open an existing group of a file
!> @brief Open an existing group in a file.
!--------------------------------------------------------------------------------------------------
integer(HID_T) function HDF5_openGroup(fileHandle,groupName)
@ -304,7 +297,7 @@ end function HDF5_openGroup
!--------------------------------------------------------------------------------------------------
!> @brief close a group
!> @brief Close a group.
!--------------------------------------------------------------------------------------------------
subroutine HDF5_closeGroup(group_id)
@ -330,11 +323,7 @@ logical function HDF5_objectExists(loc_id,path)
character(len=:), allocatable :: p
if (present(path)) then
p = trim(path)
else
p = '.'
end if
p = trim(misc_optional(path,'.'))
call H5Lexists_f(loc_id, p, HDF5_objectExists, hdferr)
if (hdferr < 0) error stop 'HDF5 error'
@ -364,11 +353,7 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path)
type(C_PTR), target, dimension(1) :: ptr
if (present(path)) then
p = trim(path)
else
p = '.'
end if
p = trim(misc_optional(path,'.'))
attrValue_(1) = trim(attrValue)//C_NULL_CHAR
ptr(1) = c_loc(attrValue_(1))
@ -376,14 +361,14 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path)
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,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,p,attrLabel,hdferr)
if (hdferr < 0) error stop 'HDF5 error'
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,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
if (hdferr < 0) error stop 'HDF5 error'
@ -412,23 +397,19 @@ subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path)
character(len=:), allocatable :: p
if (present(path)) then
p = trim(path)
else
p = '.'
end if
p = trim(misc_optional(path,'.'))
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,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,p,attrLabel,hdferr)
if (hdferr < 0) error stop 'HDF5 error'
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,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)
if (hdferr < 0) error stop 'HDF5 error'
@ -457,23 +438,19 @@ subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path)
character(len=:), allocatable :: p
if (present(path)) then
p = trim(path)
else
p = '.'
end if
p = trim(misc_optional(path,'.'))
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,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,p,attrLabel,hdferr)
if (hdferr < 0) error stop 'HDF5 error'
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,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)
if (hdferr < 0) error stop 'HDF5 error'
@ -504,11 +481,7 @@ subroutine HDF5_addAttribute_str_array(loc_id,attrLabel,attrValue,path)
type(C_PTR), target, dimension(size(attrValue)) :: ptr
if (present(path)) then
p = trim(path)
else
p = '.'
end if
p = trim(misc_optional(path,'.'))
do i=1,size(attrValue)
attrValue_(i) = attrValue(i)//C_NULL_CHAR
@ -518,14 +491,14 @@ subroutine HDF5_addAttribute_str_array(loc_id,attrLabel,attrValue,path)
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,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,p,attrLabel,hdferr)
if (hdferr < 0) error stop 'HDF5 error'
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,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
if (hdferr < 0) error stop 'HDF5 error'
@ -555,25 +528,21 @@ subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path)
character(len=:), allocatable :: p
if (present(path)) then
p = trim(path)
else
p = '.'
end if
p = trim(misc_optional(path,'.'))
array_size = size(attrValue,kind=HSIZE_T)
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,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,p,attrLabel,hdferr)
if (hdferr < 0) error stop 'HDF5 error'
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,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)
if (hdferr < 0) error stop 'HDF5 error'
@ -603,25 +572,21 @@ subroutine HDF5_addAttribute_real_array(loc_id,attrLabel,attrValue,path)
character(len=:), allocatable :: p
if (present(path)) then
p = trim(path)
else
p = '.'
end if
p = trim(misc_optional(path,'.'))
array_size = size(attrValue,kind=HSIZE_T)
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,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,p,attrLabel,hdferr)
if (hdferr < 0) error stop 'HDF5 error'
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,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)
if (hdferr < 0) error stop 'HDF5 error'
@ -676,13 +641,10 @@ subroutine HDF5_read_real1(dataset,loc_id,datasetName,parallel)
myShape = int(shape(dataset),HSIZE_T)
if (present(parallel)) then
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
end if
call initialize_read(dset_id,filespace_id,memspace_id,plist_id, aplist_id, &
myStart,totalShape,loc_id,myShape,datasetName, &
misc_optional(parallel,parallel_default))
if (any(totalShape == 0)) return
call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
@ -713,13 +675,10 @@ subroutine HDF5_read_real2(dataset,loc_id,datasetName,parallel)
myShape = int(shape(dataset),HSIZE_T)
if (present(parallel)) then
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
end if
call initialize_read(dset_id,filespace_id,memspace_id,plist_id,aplist_id, &
myStart,totalShape,loc_id,myShape,datasetName, &
misc_optional(parallel,parallel_default))
if (any(totalShape == 0)) return
call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
@ -750,13 +709,10 @@ subroutine HDF5_read_real3(dataset,loc_id,datasetName,parallel)
myShape = int(shape(dataset),HSIZE_T)
if (present(parallel)) then
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
end if
call initialize_read(dset_id,filespace_id,memspace_id,plist_id,aplist_id, &
myStart,totalShape,loc_id,myShape,datasetName, &
misc_optional(parallel,parallel_default))
if (any(totalShape == 0)) return
call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
@ -788,13 +744,10 @@ subroutine HDF5_read_real4(dataset,loc_id,datasetName,parallel)
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_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
end if
call initialize_read(dset_id,filespace_id,memspace_id,plist_id,aplist_id, &
myStart,totalShape,loc_id,myShape,datasetName, &
misc_optional(parallel,parallel_default))
if (any(totalShape == 0)) return
call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
@ -826,13 +779,10 @@ subroutine HDF5_read_real5(dataset,loc_id,datasetName,parallel)
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_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
end if
call initialize_read(dset_id,filespace_id,memspace_id,plist_id,aplist_id, &
myStart,totalShape,loc_id,myShape,datasetName, &
misc_optional(parallel,parallel_default))
if (any(totalShape == 0)) return
call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
@ -864,14 +814,11 @@ subroutine HDF5_read_real6(dataset,loc_id,datasetName,parallel)
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_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
end if
if (any(totalShape == 0)) return
call initialize_read(dset_id,filespace_id,memspace_id,plist_id,aplist_id, &
myStart,totalShape,loc_id,myShape,datasetName, &
misc_optional(parallel,parallel_default))
if (any(totalShape == 0)) return
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)
@ -902,13 +849,10 @@ subroutine HDF5_read_real7(dataset,loc_id,datasetName,parallel)
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_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
end if
call initialize_read(dset_id,filespace_id,memspace_id,plist_id,aplist_id, &
myStart,totalShape,loc_id,myShape,datasetName, &
misc_optional(parallel,parallel_default))
if (any(totalShape == 0)) return
call H5Dread_f(dset_id, H5T_NATIVE_DOUBLE,dataset,totalShape, hdferr,&
@ -940,14 +884,11 @@ subroutine HDF5_read_int1(dataset,loc_id,datasetName,parallel)
myShape = int(shape(dataset),HSIZE_T)
if (present(parallel)) then
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
end if
if (any(totalShape == 0)) return
call initialize_read(dset_id,filespace_id,memspace_id,plist_id,aplist_id, &
myStart,totalShape,loc_id,myShape,datasetName, &
misc_optional(parallel,parallel_default))
if (any(totalShape == 0)) return
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)
@ -978,13 +919,10 @@ subroutine HDF5_read_int2(dataset,loc_id,datasetName,parallel)
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_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
end if
call initialize_read(dset_id,filespace_id,memspace_id,plist_id,aplist_id, &
myStart,totalShape,loc_id,myShape,datasetName, &
misc_optional(parallel,parallel_default))
if (any(totalShape == 0)) return
call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
@ -1015,13 +953,10 @@ subroutine HDF5_read_int3(dataset,loc_id,datasetName,parallel)
myShape = int(shape(dataset),HSIZE_T)
if (present(parallel)) then
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
end if
call initialize_read(dset_id,filespace_id,memspace_id,plist_id,aplist_id, &
myStart,totalShape,loc_id,myShape,datasetName, &
misc_optional(parallel,parallel_default))
if (any(totalShape == 0)) return
call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
@ -1052,13 +987,10 @@ subroutine HDF5_read_int4(dataset,loc_id,datasetName,parallel)
myShape = int(shape(dataset),HSIZE_T)
if (present(parallel)) then
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
end if
call initialize_read(dset_id,filespace_id,memspace_id,plist_id,aplist_id, &
myStart,totalShape,loc_id,myShape,datasetName, &
misc_optional(parallel,parallel_default))
if (any(totalShape == 0)) return
call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
@ -1089,13 +1021,10 @@ subroutine HDF5_read_int5(dataset,loc_id,datasetName,parallel)
myShape = int(shape(dataset),HSIZE_T)
if (present(parallel)) then
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
end if
call initialize_read(dset_id,filespace_id,memspace_id,plist_id,aplist_id, &
myStart,totalShape,loc_id,myShape,datasetName, &
misc_optional(parallel,parallel_default))
if (any(totalShape == 0)) return
call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
@ -1127,13 +1056,10 @@ subroutine HDF5_read_int6(dataset,loc_id,datasetName,parallel)
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_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
end if
call initialize_read(dset_id,filespace_id,memspace_id,plist_id,aplist_id, &
myStart,totalShape,loc_id,myShape,datasetName, &
misc_optional(parallel,parallel_default))
if (any(totalShape == 0)) return
call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
@ -1165,13 +1091,10 @@ subroutine HDF5_read_int7(dataset,loc_id,datasetName,parallel)
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_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel)
else
call initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
myStart, totalShape, loc_id,myShape,datasetName,parallel_default)
end if
call initialize_read(dset_id,filespace_id,memspace_id,plist_id,aplist_id, &
myStart,totalShape,loc_id,myShape,datasetName, &
misc_optional(parallel,parallel_default))
if (any(totalShape == 0)) return
call H5Dread_f(dset_id, H5T_NATIVE_INTEGER,dataset,totalShape, hdferr,&
@ -1207,13 +1130,9 @@ subroutine HDF5_write_real1(dataset,loc_id,datasetName,parallel)
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
call initialize_write(dset_id,filespace_id,memspace_id,plist_id, &
myStart,totalShape,loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE, &
misc_optional(parallel,parallel_default))
if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
@ -1248,13 +1167,9 @@ subroutine HDF5_write_real2(dataset,loc_id,datasetName,parallel)
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
call initialize_write(dset_id,filespace_id,memspace_id,plist_id, &
myStart,totalShape,loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE, &
misc_optional(parallel,parallel_default))
if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
@ -1289,13 +1204,9 @@ subroutine HDF5_write_real3(dataset,loc_id,datasetName,parallel)
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
call initialize_write(dset_id,filespace_id,memspace_id,plist_id, &
myStart,totalShape,loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE, &
misc_optional(parallel,parallel_default))
if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
@ -1330,13 +1241,9 @@ subroutine HDF5_write_real4(dataset,loc_id,datasetName,parallel)
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
call initialize_write(dset_id,filespace_id,memspace_id,plist_id, &
myStart,totalShape,loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE, &
misc_optional(parallel,parallel_default))
if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
@ -1372,13 +1279,9 @@ subroutine HDF5_write_real5(dataset,loc_id,datasetName,parallel)
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
call initialize_write(dset_id,filespace_id,memspace_id,plist_id, &
myStart,totalShape,loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE, &
misc_optional(parallel,parallel_default))
if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
@ -1413,13 +1316,9 @@ subroutine HDF5_write_real6(dataset,loc_id,datasetName,parallel)
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
call initialize_write(dset_id,filespace_id,memspace_id,plist_id, &
myStart,totalShape,loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE, &
misc_optional(parallel,parallel_default))
if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
@ -1454,13 +1353,9 @@ subroutine HDF5_write_real7(dataset,loc_id,datasetName,parallel)
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
call initialize_write(dset_id,filespace_id,memspace_id,plist_id, &
myStart,totalShape,loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE, &
misc_optional(parallel,parallel_default))
if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_DOUBLE,dataset,int(totalShape,HSIZE_T), hdferr,&
@ -1497,13 +1392,9 @@ subroutine HDF5_write_real(dataset,loc_id,datasetName,parallel)
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
call initialize_write(dset_id,filespace_id,memspace_id,plist_id, &
myStart,totalShape,loc_id,myShape,datasetName,H5T_NATIVE_DOUBLE, &
misc_optional(parallel,parallel_default))
if (product(totalShape) /= 0) then
select rank(dataset)
@ -1624,13 +1515,9 @@ subroutine HDF5_write_int1(dataset,loc_id,datasetName,parallel)
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
call initialize_write(dset_id,filespace_id,memspace_id,plist_id, &
myStart,totalShape,loc_id,myShape,datasetName,H5T_NATIVE_INTEGER, &
misc_optional(parallel,parallel_default))
if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
@ -1665,13 +1552,9 @@ subroutine HDF5_write_int2(dataset,loc_id,datasetName,parallel)
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
call initialize_write(dset_id,filespace_id,memspace_id,plist_id, &
myStart,totalShape,loc_id,myShape,datasetName,H5T_NATIVE_INTEGER, &
misc_optional(parallel,parallel_default))
if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
@ -1706,13 +1589,9 @@ subroutine HDF5_write_int3(dataset,loc_id,datasetName,parallel)
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
call initialize_write(dset_id,filespace_id,memspace_id,plist_id, &
myStart,totalShape,loc_id,myShape,datasetName,H5T_NATIVE_INTEGER, &
misc_optional(parallel,parallel_default))
if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
@ -1747,13 +1626,9 @@ subroutine HDF5_write_int4(dataset,loc_id,datasetName,parallel)
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
call initialize_write(dset_id,filespace_id,memspace_id,plist_id, &
myStart,totalShape,loc_id,myShape,datasetName,H5T_NATIVE_INTEGER, &
misc_optional(parallel,parallel_default))
if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
@ -1788,18 +1663,14 @@ subroutine HDF5_write_int5(dataset,loc_id,datasetName,parallel)
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
call initialize_write(dset_id,filespace_id,memspace_id,plist_id, &
myStart,totalShape,loc_id,myShape,datasetName,H5T_NATIVE_INTEGER, &
misc_optional(parallel,parallel_default))
if (product(totalShape) /= 0) then
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'
if (hdferr < 0) error stop 'HDF5 error'
end if
call finalize_write(plist_id, dset_id, filespace_id, memspace_id)
@ -1829,13 +1700,9 @@ subroutine HDF5_write_int6(dataset,loc_id,datasetName,parallel)
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
call initialize_write(dset_id,filespace_id,memspace_id,plist_id, &
myStart,totalShape,loc_id,myShape,datasetName,H5T_NATIVE_INTEGER, &
misc_optional(parallel,parallel_default))
if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
@ -1870,13 +1737,9 @@ subroutine HDF5_write_int7(dataset,loc_id,datasetName,parallel)
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
call initialize_write(dset_id,filespace_id,memspace_id,plist_id, &
myStart,totalShape,loc_id,myShape,datasetName,H5T_NATIVE_INTEGER, &
misc_optional(parallel,parallel_default))
if (product(totalShape) /= 0) then
call H5Dwrite_f(dset_id, H5T_NATIVE_INTEGER,dataset,int(totalShape,HSIZE_T), hdferr,&
@ -1913,13 +1776,9 @@ subroutine HDF5_write_int(dataset,loc_id,datasetName,parallel)
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
call initialize_write(dset_id,filespace_id,memspace_id,plist_id, &
myStart,totalShape,loc_id,myShape,datasetName,H5T_NATIVE_INTEGER, &
misc_optional(parallel,parallel_default))
if (product(totalShape) /= 0) then
select rank(dataset)

1
src/Marc/DAMASK_Marc.f90
View File

@ -142,6 +142,7 @@ end function solverIsSymmetric
end module DAMASK_interface
#include "../parallelization.f90"
#include "../misc.f90"
#include "../constants.f90"
#include "../IO.f90"
#include "../YAML_types.f90"

88
src/YAML_parse.f90
View File

@ -1,11 +1,12 @@
!----------------------------------------------------------------------------------------------------
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @author Sharan Roongta, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Parser for YAML files
!> @details module converts a YAML input file to an equivalent YAML flow style which is then parsed.
!> @brief Parser for YAML files.
!> @details Module converts a YAML input file to an equivalent YAML flow style which is then parsed.
!----------------------------------------------------------------------------------------------------
module YAML_parse
use prec
use misc
use IO
use YAML_types
#ifdef FYAML
@ -54,7 +55,7 @@ end subroutine YAML_parse_init
!--------------------------------------------------------------------------------------------------
!> @brief Parse a YAML string with list as root into a a structure of nodes.
!> @brief Parse a YAML string with list at root into a structure of nodes.
!> @details The string needs to end with a newline (unless using libfyaml).
!--------------------------------------------------------------------------------------------------
function YAML_parse_str_asList(str) result(list)
@ -72,7 +73,7 @@ end function YAML_parse_str_asList
!--------------------------------------------------------------------------------------------------
!> @brief Parse a YAML string with dict as root into a a structure of nodes.
!> @brief Parse a YAML string with dict at root into a structure of nodes.
!> @details The string needs to end with a newline (unless using libfyaml).
!--------------------------------------------------------------------------------------------------
function YAML_parse_str_asDict(str) result(dict)
@ -90,8 +91,8 @@ end function YAML_parse_str_asDict
!--------------------------------------------------------------------------------------------------
!> @brief reads the flow style string and stores it in the form of dictionaries, lists and scalars.
!> @details A node type pointer can either point to a dictionary, list or scalar type entities.
!> @brief Read a string in flow style and store it in the form of dictionaries, lists, and scalars.
!> @details A node-type pointer can either point to a dictionary, list, or scalar type entities.
!--------------------------------------------------------------------------------------------------
recursive function parse_flow(YAML_flow) result(node)
@ -157,7 +158,7 @@ end function parse_flow
!--------------------------------------------------------------------------------------------------
!> @brief finds location of chunk end: ',' or '}' or ']'
!> @brief Find location of chunk end: ',' '}', or ']'.
!> @details leaves nested lists ( '[...]' and dicts '{...}') intact
!--------------------------------------------------------------------------------------------------
integer function find_end(str,e_char)
@ -187,7 +188,7 @@ end function find_end
!--------------------------------------------------------------------------------------------------
! @brief check whether a string is enclosed with single or double quotes
! @brief Check whether a string is enclosed with single or double quotes.
!--------------------------------------------------------------------------------------------------
logical function quotedString(line)
@ -208,7 +209,7 @@ end function quotedString
#ifdef FYAML
!--------------------------------------------------------------------------------------------------
! @brief Convert all block style YAML parts to flow style.
! @brief Convert all block-style YAML parts to flow style.
!--------------------------------------------------------------------------------------------------
function to_flow(mixed) result(flow)
@ -236,41 +237,43 @@ end function to_flow
#else
!--------------------------------------------------------------------------------------------------
! @brief Determine Indentation.
! @details It determines the indentation level for a given block/line.
! In cases for nested lists, an offset is added to determine the indent of the item block (skip
! leading dashes)
! @brief Determine indentation depth.
! @details Indentation level is determined for a given block/line.
! In case of nested lists, an offset is added to determine the indent of the item block (skip
! leading dashes).
!--------------------------------------------------------------------------------------------------
integer function indentDepth(line,offset)
character(len=*), intent(in) :: line
integer, optional,intent(in) :: offset
indentDepth = verify(line,IO_WHITESPACE) -1
if (present(offset)) indentDepth = indentDepth + offset
indentDepth = verify(line,IO_WHITESPACE) - 1 + misc_optional(offset,0)
end function indentDepth
!--------------------------------------------------------------------------------------------------
! @brief check whether a string is in flow style, i.e. starts with '{' or '['
! @brief Check whether a string is in flow style, i.e. starts with '{' or '['.
!--------------------------------------------------------------------------------------------------
logical function isFlow(line)
character(len=*), intent(in) :: line
isFlow = index(adjustl(line),'[') == 1 .or. index(adjustl(line),'{') == 1
end function isFlow
!--------------------------------------------------------------------------------------------------
! @brief check whether a string is a scalar item, i.e. starts without any special symbols
! @brief Check whether a string is a scalar item, i.e. starts without any special symbols.
!--------------------------------------------------------------------------------------------------
logical function isScalar(line)
character(len=*), intent(in) :: line
isScalar = (.not. isKeyValue(line) .and. &
.not. isKey(line) .and. &
.not. isListItem(line) .and. &
@ -280,12 +283,13 @@ end function isScalar
!--------------------------------------------------------------------------------------------------
! @brief check whether a string is a list item, i.e. starts with '-'
! @brief Check whether a string is a list item, i.e. starts with '-'.
!--------------------------------------------------------------------------------------------------
logical function isListItem(line)
character(len=*), intent(in) :: line
isListItem = .false.
if (len_trim(adjustl(line))> 2 .and. index(trim(adjustl(line)), '-') == 1) then
isListItem = scan(trim(adjustl(line)),' ') == 2
@ -297,13 +301,14 @@ end function isListItem
!--------------------------------------------------------------------------------------------------
! @brief check whether a string contains a key value pair of the for '<key>: <value>'
! @brief Check whether a string contains a key-value pair of the form '<key>: <value>'.
!--------------------------------------------------------------------------------------------------
logical function isKeyValue(line)
character(len=*), intent(in) :: line
isKeyValue = .false.
if ( .not. isKey(line) .and. index(IO_rmComment(line),':') > 0 .and. .not. isFlow(line)) then
if (index(IO_rmComment(line),': ') > 0) isKeyValue = .true.
end if
@ -312,13 +317,14 @@ end function isKeyValue
!--------------------------------------------------------------------------------------------------
! @brief check whether a string contains a key without a value, i.e. it ends with ':'
! ToDo: check whether this is safe for trailing spaces followed by a new line character
! @brief Check whether a string contains a key without a value, i.e. it ends in ':'.
! ToDo: check whether this is safe for trailing spaces followed by a newline character
!--------------------------------------------------------------------------------------------------
logical function isKey(line)
character(len=*), intent(in) :: line
if (len(IO_rmComment(line)) == 0) then
isKey = .false.
else
@ -331,20 +337,21 @@ end function isKey
!--------------------------------------------------------------------------------------------------
! @brief check whether a string is a list in flow style
! @brief Check whether a string is a list in flow style.
!--------------------------------------------------------------------------------------------------
logical function isFlowList(line)
character(len=*), intent(in) :: line
isFlowList = index(adjustl(line),'[') == 1
end function isFlowList
!--------------------------------------------------------------------------------------------------
! @brief skip empty lines
! @details update start position in the block by skipping empty lines if present.
! @brief Skip empty lines.
! @details Update start position in the block by skipping empty lines if present.
!--------------------------------------------------------------------------------------------------
subroutine skip_empty_lines(blck,s_blck)
@ -353,6 +360,7 @@ subroutine skip_empty_lines(blck,s_blck)
logical :: empty
empty = .true.
do while(empty .and. len_trim(blck(s_blck:)) /= 0)
empty = len_trim(IO_rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))) == 0
@ -363,8 +371,8 @@ end subroutine skip_empty_lines
!--------------------------------------------------------------------------------------------------
! @brief skip file header
! @details update start position in the block by skipping file header if present.
! @brief Skip file header.
! @details Update start position in the block by skipping file header if present.
!--------------------------------------------------------------------------------------------------
subroutine skip_file_header(blck,s_blck)
@ -373,6 +381,7 @@ subroutine skip_file_header(blck,s_blck)
character(len=:), allocatable :: line
line = IO_rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))
if (index(adjustl(line),'%YAML') == 1) then
s_blck = s_blck + index(blck(s_blck:),IO_EOL)
@ -388,7 +397,7 @@ end subroutine skip_file_header
!--------------------------------------------------------------------------------------------------
!> @brief check if a line in flow YAML starts and ends in the same line
!> @brief Check whether a line in flow style starts and ends on the same line.
!--------------------------------------------------------------------------------------------------
logical function flow_is_closed(str,e_char)
@ -399,6 +408,7 @@ logical function flow_is_closed(str,e_char)
i
character(len=:), allocatable:: line
flow_is_closed = .false.
N_sq = 0
N_cu = 0
@ -417,7 +427,7 @@ end function flow_is_closed
!--------------------------------------------------------------------------------------------------
!> @brief return the flow YAML line without line break
!> @brief Return a flow-style line without line break.
!--------------------------------------------------------------------------------------------------
subroutine remove_line_break(blck,s_blck,e_char,flow_line)
@ -427,6 +437,7 @@ subroutine remove_line_break(blck,s_blck,e_char,flow_line)
character(len=:), allocatable, intent(out) :: flow_line
logical :: line_end
line_end =.false.
flow_line = ''
@ -440,7 +451,7 @@ end subroutine remove_line_break
!--------------------------------------------------------------------------------------------------
!> @brief return the scalar list item without line break
!> @brief Return a scalar list item without line break.
!--------------------------------------------------------------------------------------------------
subroutine list_item_inline(blck,s_blck,inline,offset)
@ -452,6 +463,7 @@ subroutine list_item_inline(blck,s_blck,inline,offset)
character(len=:), allocatable :: line
integer :: indent,indent_next
indent = indentDepth(blck(s_blck:),offset)
line = IO_rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2))
inline = line(indent-offset+3:)
@ -471,8 +483,8 @@ end subroutine list_item_inline
!--------------------------------------------------------------------------------------------------
! @brief reads a line of YAML block which is already in flow style
! @details A dict should be enclosed within '{}' for it to be consistent with the DAMASK YAML parser
! @brief Read a line of YAML block that is already in flow style.
! @details A dict should be enclosed within '{}' for it to be consistent with the DAMASK YAML parser.
!--------------------------------------------------------------------------------------------------
recursive subroutine line_isFlow(flow,s_flow,line)
@ -485,6 +497,7 @@ recursive subroutine line_isFlow(flow,s_flow,line)
list_chunk, &
dict_chunk
if (index(adjustl(line),'[') == 1) then
s = index(line,'[')
flow(s_flow:s_flow) = '['
@ -535,8 +548,8 @@ end subroutine line_isFlow
!-------------------------------------------------------------------------------------------------
! @brief reads a line of YAML block of type <key>: <value> and places it in the YAML flow style structure
! @details Makes sure that the <value> is consistent with the input required in DAMASK YAML parser
! @brief Transform a line of YAML of type <key>: <value> to flow style.
! @details Ensures that the <value> is consistent with the input required in the DAMASK YAML parser.
!-------------------------------------------------------------------------------------------------
recursive subroutine keyValue_toFlow(flow,s_flow,line)
@ -550,6 +563,7 @@ recursive subroutine keyValue_toFlow(flow,s_flow,line)
col_pos, &
offset_value
col_pos = index(line,':')
if (line(col_pos+1:col_pos+1) /= ' ') call IO_error(704,ext_msg=line)
if (isFlow(line(col_pos+1:))) then
@ -567,7 +581,7 @@ end subroutine keyValue_toFlow
!-------------------------------------------------------------------------------------------------
! @brief reads a line of YAML block and places it in the YAML flow style structure
! @brief Transform a line of YAML to flow style.
!-------------------------------------------------------------------------------------------------
subroutine line_toFlow(flow,s_flow,line)
@ -586,7 +600,7 @@ end subroutine line_toFlow
!-------------------------------------------------------------------------------------------------
! @brief convert a yaml list in block style to a yaml list in flow style
! @brief Transform a block-style list to flow style.
! @details enters the function when encountered with the list indicator '- '
! reads each scalar list item and separates each other with a ','
! If list item is non scalar, it stores the offset for that list item block
@ -679,7 +693,7 @@ end subroutine lst
!--------------------------------------------------------------------------------------------------
! @brief convert a yaml dict in block style to a yaml dict in flow style
! @brief Transform a block-style dict to flow style.
! @details enters the function when encountered with the dictionary indicator ':'
! parses each line in the block and compares indentation of a line with the preceding line
! upon increase in indentation level -> 'decide' function decides if the line is a list or dict
@ -817,7 +831,7 @@ end subroutine decide
!--------------------------------------------------------------------------------------------------
!> @brief Convert all block style YAML parts to flow style.
!> @brief Convert all block-style parts to flow style.
!> @details The input needs to end with a newline.
!--------------------------------------------------------------------------------------------------
function to_flow(blck)

15
src/lattice.f90
View File

@ -8,6 +8,7 @@
!--------------------------------------------------------------------------------------------------
module lattice
use prec
use misc
use IO
use config
use math
@ -2159,12 +2160,8 @@ pure function lattice_isotropic_nu(C,assumption,lattice) result(nu)
real(pReal) :: K, mu
logical :: error
real(pReal), dimension(6,6) :: S
character(len=:), allocatable :: lattice_
lattice_ = IO_WHITESPACE
if (present(lattice)) lattice_ = lattice
if (IO_lc(assumption) == 'isostrain') then
K = sum(C(1:3,1:3)) / 9.0_pReal
elseif (IO_lc(assumption) == 'isostress') then
@ -2175,7 +2172,7 @@ pure function lattice_isotropic_nu(C,assumption,lattice) result(nu)
error stop 'invalid assumption'
end if
mu = lattice_isotropic_mu(C,assumption,lattice_)
mu = lattice_isotropic_mu(C,assumption,misc_optional(lattice,''))
nu = (1.5_pReal*K-mu)/(3.0_pReal*K+mu)
end function lattice_isotropic_nu
@ -2195,14 +2192,10 @@ pure function lattice_isotropic_mu(C,assumption,lattice) result(mu)
logical :: error
real(pReal), dimension(6,6) :: S
character(len=:), allocatable :: lattice_
lattice_ = IO_WHITESPACE
if (present(lattice)) lattice_ = lattice
if (IO_lc(assumption) == 'isostrain') then
select case(lattice_)
select case(misc_optional(lattice,''))
case('cF','cI')
mu = ( C(1,1) - C(1,2) + C(4,4)*3.0_pReal) / 5.0_pReal
case default
@ -2213,7 +2206,7 @@ pure function lattice_isotropic_mu(C,assumption,lattice) result(mu)
end select
elseif (IO_lc(assumption) == 'isostress') then
select case(lattice_)
select case(misc_optional(lattice,''))
case('cF','cI')
mu = 5.0_pReal &
/ (4.0_pReal/(C(1,1)-C(1,2)) + 3.0_pReal/C(4,4))

72
src/math.f90
View File

@ -7,6 +7,7 @@
!--------------------------------------------------------------------------------------------------
module math
use prec
use misc
use IO
use config
use YAML_types
@ -140,23 +141,9 @@ pure recursive subroutine math_sort(a, istart, iend, sortDim)
integer :: ipivot,s,e,d
if (present(istart)) then
s = istart
else
s = lbound(a,2)
end if
if (present(iend)) then
e = iend
else
e = ubound(a,2)
end if
if (present(sortDim)) then
d = sortDim
else
d = 1
end if
s = misc_optional(istart,lbound(a,2))
e = misc_optional(iend,ubound(a,2))
d = misc_optional(sortDim,1)
if (s < e) then
call qsort_partition(a,ipivot, s,e, d)
@ -448,20 +435,14 @@ pure function math_exp33(A,n)
real(pReal), dimension(3,3) :: B, math_exp33
real(pReal) :: invFac
integer :: n_,i
integer :: i
if (present(n)) then
n_ = n
else
n_ = 5
end if
invFac = 1.0_pReal ! 0!
B = math_I3
math_exp33 = math_I3 ! A^0 = I
do i = 1, n_
do i = 1, misc_optional(n,5)
invFac = invFac/real(i,pReal) ! invfac = 1/(i!)
B = matmul(B,A)
math_exp33 = math_exp33 + invFac*B ! exp = SUM (A^i)/(i!)
@ -729,12 +710,7 @@ pure function math_sym33to6(m33,weighted)
real(pReal), dimension(6) :: w
integer :: i
if (present(weighted)) then
w = merge(NRMMANDEL,1.0_pReal,weighted)
else
w = NRMMANDEL
end if
w = merge(NRMMANDEL,1.0_pReal,misc_optional(weighted,.true.))
math_sym33to6 = [(w(i)*m33(MAPNYE(1,i),MAPNYE(2,i)),i=1,6)]
@ -757,11 +733,7 @@ pure function math_6toSym33(v6,weighted)
integer :: i
if (present(weighted)) then
w = merge(INVNRMMANDEL,1.0_pReal,weighted)
else
w = INVNRMMANDEL
end if
w = merge(INVNRMMANDEL,1.0_pReal,misc_optional(weighted,.true.))
do i=1,6
math_6toSym33(MAPNYE(1,i),MAPNYE(2,i)) = w(i)*v6(i)
@ -831,11 +803,7 @@ pure function math_sym3333to66(m3333,weighted)
integer :: i,j
if (present(weighted)) then
w = merge(NRMMANDEL,1.0_pReal,weighted)
else
w = NRMMANDEL
end if
w = merge(NRMMANDEL,1.0_pReal,misc_optional(weighted,.true.))
#ifndef __INTEL_COMPILER
do concurrent(i=1:6, j=1:6)
@ -864,11 +832,7 @@ pure function math_66toSym3333(m66,weighted)
integer :: i,j
if (present(weighted)) then
w = merge(INVNRMMANDEL,1.0_pReal,weighted)
else
w = INVNRMMANDEL
end if
w = merge(INVNRMMANDEL,1.0_pReal,misc_optional(weighted,.true.))
do i=1,6; do j=1,6
math_66toSym3333(MAPNYE(1,i),MAPNYE(2,i),MAPNYE(1,j),MAPNYE(2,j)) = w(i)*w(j)*m66(i,j)
@ -996,24 +960,12 @@ impure elemental subroutine math_normal(x,mu,sigma)
real(pReal), intent(out) :: x
real(pReal), intent(in), optional :: mu, sigma
real(pReal) :: sigma_, mu_
real(pReal), dimension(2) :: rnd
if (present(mu)) then
mu_ = mu
else
mu_ = 0.0_pReal
end if
if (present(sigma)) then
sigma_ = sigma
else
sigma_ = 1.0_pReal
end if
call random_number(rnd)
x = mu_ + sigma_ * sqrt(-2.0_pReal*log(1.0_pReal-rnd(1)))*cos(TAU*(1.0_pReal - rnd(2)))
x = misc_optional(mu,0.0_pReal) &
+ misc_optional(sigma,1.0_pReal) * sqrt(-2.0_pReal*log(1.0_pReal-rnd(1)))*cos(TAU*(1.0_pReal - rnd(2)))
end subroutine math_normal

100
src/misc.f90 Normal file
View File

@ -0,0 +1,100 @@
!--------------------------------------------------------------------------------------------------
!> @author Martin Diehl, KU Leuven
!> @author Philip Eisenlohr, Michigan State University
!> @brief Miscellaneous tools.
!--------------------------------------------------------------------------------------------------
module misc
use prec
implicit none(type,external)
private
interface misc_optional
module procedure misc_optional_bool
module procedure misc_optional_integer
module procedure misc_optional_real
module procedure misc_optional_string
end interface misc_optional
public :: &
misc_optional
contains
!--------------------------------------------------------------------------------------------------
!> @brief Return bool value if given, otherwise default.
!--------------------------------------------------------------------------------------------------
pure function misc_optional_bool(given,default) result(var)
logical, intent(in), optional :: given
logical, intent(in) :: default
logical :: var
if (present(given)) then
var = given
else
var = default
end if
end function misc_optional_bool
!--------------------------------------------------------------------------------------------------
!> @brief Return integer value if given, otherwise default.
!--------------------------------------------------------------------------------------------------
pure function misc_optional_integer(given,default) result(var)
integer, intent(in), optional :: given
integer, intent(in) :: default
integer :: var
if (present(given)) then
var = given
else
var = default
end if
end function misc_optional_integer
!--------------------------------------------------------------------------------------------------
!> @brief Return real value if given, otherwise default.
!--------------------------------------------------------------------------------------------------
pure function misc_optional_real(given,default) result(var)
real(pReal), intent(in), optional :: given
real(pReal), intent(in) :: default
real(pReal) :: var
if (present(given)) then
var = given
else
var = default
end if
end function misc_optional_real
!--------------------------------------------------------------------------------------------------
!> @brief Return string value if given, otherwise default.
!--------------------------------------------------------------------------------------------------
pure function misc_optional_string(given,default) result(var)
character(len=*), intent(in), optional :: given
character(len=*), intent(in) :: default
character(len=:), allocatable :: var
if (present(given)) then
var = given
else
var = default
end if
end function misc_optional_string
end module misc

46
src/result.f90
View File

@ -6,6 +6,7 @@
!--------------------------------------------------------------------------------------------------
module result
use prec
use misc
use parallelization
use IO
use HDF5_utilities
@ -224,11 +225,7 @@ subroutine result_addAttribute_str(attrLabel,attrValue,path)
character(len=*), intent(in), optional :: path
if (present(path)) then
call HDF5_addAttribute(resultFile,attrLabel, attrValue, path)
else
call HDF5_addAttribute(resultFile,attrLabel, attrValue)
end if
call HDF5_addAttribute(resultFile,attrLabel, attrValue, path)
end subroutine result_addAttribute_str
@ -243,11 +240,7 @@ subroutine result_addAttribute_int(attrLabel,attrValue,path)
character(len=*), intent(in), optional :: path
if (present(path)) then
call HDF5_addAttribute(resultFile,attrLabel, attrValue, path)
else
call HDF5_addAttribute(resultFile,attrLabel, attrValue)
end if
call HDF5_addAttribute(resultFile,attrLabel, attrValue, path)
end subroutine result_addAttribute_int
@ -262,11 +255,7 @@ subroutine result_addAttribute_real(attrLabel,attrValue,path)
character(len=*), intent(in), optional :: path
if (present(path)) then
call HDF5_addAttribute(resultFile,attrLabel, attrValue, path)
else
call HDF5_addAttribute(resultFile,attrLabel, attrValue)
end if
call HDF5_addAttribute(resultFile,attrLabel, attrValue, path)
end subroutine result_addAttribute_real
@ -281,11 +270,7 @@ subroutine result_addAttribute_str_array(attrLabel,attrValue,path)
character(len=*), intent(in), optional :: path
if (present(path)) then
call HDF5_addAttribute(resultFile,attrLabel, attrValue, path)
else
call HDF5_addAttribute(resultFile,attrLabel, attrValue)
end if
call HDF5_addAttribute(resultFile,attrLabel, attrValue, path)
end subroutine result_addAttribute_str_array
@ -300,11 +285,7 @@ subroutine result_addAttribute_int_array(attrLabel,attrValue,path)
character(len=*), intent(in), optional :: path
if (present(path)) then
call HDF5_addAttribute(resultFile,attrLabel, attrValue, path)
else
call HDF5_addAttribute(resultFile,attrLabel, attrValue)
end if
call HDF5_addAttribute(resultFile,attrLabel, attrValue, path)
end subroutine result_addAttribute_int_array
@ -319,11 +300,7 @@ subroutine result_addAttribute_real_array(attrLabel,attrValue,path)
character(len=*), intent(in), optional :: path
if (present(path)) then
call HDF5_addAttribute(resultFile,attrLabel, attrValue, path)
else
call HDF5_addAttribute(resultFile,attrLabel, attrValue)
end if
call HDF5_addAttribute(resultFile,attrLabel, attrValue, path)
end subroutine result_addAttribute_real_array
@ -416,19 +393,12 @@ subroutine result_writeTensorDataset_real(dataset,group,label,description,SIunit
real(pReal), intent(in), dimension(:,:,:) :: dataset
integer :: i
logical :: transposed_
integer(HID_T) :: groupHandle
real(pReal), dimension(:,:,:), allocatable :: dataset_transposed
if (present(transposed)) then
transposed_ = transposed
else
transposed_ = .true.
end if
groupHandle = result_openGroup(group)
if (transposed_) then
if (misc_optional(transposed,.true.)) then
if (size(dataset,1) /= size(dataset,2)) error stop 'transpose non-symmetric tensor'
allocate(dataset_transposed,mold=dataset)
do i=1,size(dataset_transposed,3)

60
src/rotations.f90
View File

@ -178,11 +178,7 @@ subroutine fromEulers(self,eu,degrees)
real(pReal), dimension(3) :: Eulers
if (.not. present(degrees)) then
Eulers = eu
else
Eulers = merge(eu*INRAD,eu,degrees)
end if
Eulers = merge(eu*INRAD,eu,misc_optional(degrees,.false.))
if (any(Eulers<0.0_pReal) .or. any(Eulers>TAU) .or. Eulers(2) > PI) &
call IO_error(402,ext_msg='fromEulers')
@ -202,18 +198,10 @@ subroutine fromAxisAngle(self,ax,degrees,P)
real(pReal),dimension(3) :: axis
if (.not. present(degrees)) then
angle = ax(4)
else
angle = merge(ax(4)*INRAD,ax(4),degrees)
end if
angle = merge(ax(4)*INRAD,ax(4),misc_optional(degrees,.false.))
if (.not. present(P)) then
axis = ax(1:3)
else
axis = ax(1:3) * merge(-1.0_pReal,1.0_pReal,P == 1)
if (abs(P) /= 1) call IO_error(402,ext_msg='fromAxisAngle (P)')
end if
axis = ax(1:3) * merge(-1.0_pReal,1.0_pReal,misc_optional(P,-1) == 1)
if (abs(misc_optional(P,-1)) /= 1) call IO_error(402,ext_msg='fromAxisAngle (P)')
if (dNeq(norm2(axis),1.0_pReal) .or. angle < 0.0_pReal .or. angle > PI) &
call IO_error(402,ext_msg='fromAxisAngle')
@ -277,22 +265,15 @@ pure function rotVector(self,v,active) result(vRot)
logical, intent(in), optional :: active
real(pReal), dimension(4) :: v_normed, q
logical :: passive
if (present(active)) then
passive = .not. active
else
passive = .true.
end if
if (dEq0(norm2(v))) then
vRot = v
else
v_normed = [0.0_pReal,v]/norm2(v)
q = merge(multiplyQuaternion(self%q, multiplyQuaternion(v_normed, conjugateQuaternion(self%q))), &
multiplyQuaternion(conjugateQuaternion(self%q), multiplyQuaternion(v_normed, self%q)), &
passive)
q = merge(multiplyQuaternion(conjugateQuaternion(self%q), multiplyQuaternion(v_normed, self%q)), &
multiplyQuaternion(self%q, multiplyQuaternion(v_normed, conjugateQuaternion(self%q))), &
misc_optional(active,.false.))
vRot = q(2:4)*norm2(v)
end if
@ -311,18 +292,10 @@ pure function rotTensor2(self,T,active) result(tRot)
real(pReal), intent(in), dimension(3,3) :: T
logical, intent(in), optional :: active
logical :: passive
if (present(active)) then
passive = .not. active
else
passive = .true.
end if
tRot = merge(matmul(matmul(self%asMatrix(),T),transpose(self%asMatrix())), &
matmul(matmul(transpose(self%asMatrix()),T),self%asMatrix()), &
passive)
tRot = merge(matmul(matmul(transpose(self%asMatrix()),T),self%asMatrix()), &
matmul(matmul(self%asMatrix(),T),transpose(self%asMatrix())), &
misc_optional(active,.false.))
end function rotTensor2
@ -342,12 +315,7 @@ pure function rotTensor4(self,T,active) result(tRot)
real(pReal), dimension(3,3) :: R
integer :: i,j,k,l,m,n,o,p
if (present(active)) then
R = merge(transpose(self%asMatrix()),self%asMatrix(),active)
else
R = self%asMatrix()
end if
R = merge(transpose(self%asMatrix()),self%asMatrix(),misc_optional(active,.false.))
tRot = 0.0_pReal
do i = 1,3;do j = 1,3;do k = 1,3;do l = 1,3
@ -375,11 +343,7 @@ pure function rotStiffness(self,C,active) result(cRot)
real(pReal), dimension(6,6) :: M
if (present(active)) then
R = merge(transpose(self%asMatrix()),self%asMatrix(),active)
else
R = self%asMatrix()
end if
R = merge(transpose(self%asMatrix()),self%asMatrix(),misc_optional(active,.false.))
M = reshape([R(1,1)**2, R(2,1)**2, R(3,1)**2, &
R(2,1)*R(3,1), R(1,1)*R(3,1), R(1,1)*R(2,1), &