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!418
This commit is contained in:
Sharan Roongta 2021-07-26 13:09:49 +00:00
parent 1c17fbb97a e56f2e09a4
commit ac6d31b1f9
6 changed files with 147 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

147
src/HDF5_utilities.f90
View File

@ -71,6 +71,7 @@ module HDF5_utilities
module procedure HDF5_addAttribute_str module procedure HDF5_addAttribute_str
module procedure HDF5_addAttribute_int module procedure HDF5_addAttribute_int
module procedure HDF5_addAttribute_real module procedure HDF5_addAttribute_real
module procedure HDF5_addAttribute_str_array
module procedure HDF5_addAttribute_int_array module procedure HDF5_addAttribute_int_array
module procedure HDF5_addAttribute_real_array module procedure HDF5_addAttribute_real_array
end interface HDF5_addAttribute end interface HDF5_addAttribute
@ -270,7 +271,7 @@ end subroutine HDF5_closeGroup
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief check whether a group or a dataset exists !> @brief Check whether a group or a dataset exists.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
logical function HDF5_objectExists(loc_id,path) logical function HDF5_objectExists(loc_id,path)
@ -280,6 +281,7 @@ logical function HDF5_objectExists(loc_id,path)
integer :: hdferr integer :: hdferr
character(len=:), allocatable :: p character(len=:), allocatable :: p
if (present(path)) then if (present(path)) then
p = trim(path) p = trim(path)
else else
@ -298,7 +300,7 @@ end function HDF5_objectExists
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief adds a string attribute to the path given relative to the location !> @brief Add a string attribute to the path given relative to the location.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path) subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path)
@ -313,6 +315,7 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path)
character(len=:,kind=C_CHAR), allocatable,target :: attrValue_ character(len=:,kind=C_CHAR), allocatable,target :: attrValue_
type(c_ptr), target, dimension(1) :: ptr type(c_ptr), target, dimension(1) :: ptr
if (present(path)) then if (present(path)) then
p = trim(path) p = trim(path)
else else
@ -326,6 +329,7 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
call h5tcopy_f(H5T_STRING, type_id, hdferr) call h5tcopy_f(H5T_STRING, type_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error' 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(hdferr < 0) error stop 'HDF5 error'
if (attrExists) then if (attrExists) then
@ -336,6 +340,7 @@ subroutine HDF5_addAttribute_str(loc_id,attrLabel,attrValue,path)
if(hdferr < 0) error stop 'HDF5 error' if(hdferr < 0) error stop 'HDF5 error'
call h5awrite_f(attr_id, type_id, c_loc(ptr(1)), hdferr) call h5awrite_f(attr_id, type_id, c_loc(ptr(1)), hdferr)
if(hdferr < 0) error stop 'HDF5 error' 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' if(hdferr < 0) error stop 'HDF5 error'
call h5tclose_f(type_id,hdferr) call h5tclose_f(type_id,hdferr)
@ -347,7 +352,7 @@ end subroutine HDF5_addAttribute_str
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief adds a integer attribute to the path given relative to the location !> @brief Add an integer attribute to the path given relative to the location.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path) subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path)
@ -361,6 +366,7 @@ subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path)
logical :: attrExists logical :: attrExists
character(len=:), allocatable :: p character(len=:), allocatable :: p
if (present(path)) then if (present(path)) then
p = trim(path) p = trim(path)
else else
@ -369,6 +375,7 @@ subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path)
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' 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(hdferr < 0) error stop 'HDF5 error'
if (attrExists) then if (attrExists) then
@ -379,6 +386,7 @@ subroutine HDF5_addAttribute_int(loc_id,attrLabel,attrValue,path)
if(hdferr < 0) error stop 'HDF5 error' 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' 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' if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(space_id,hdferr) call h5sclose_f(space_id,hdferr)
@ -388,7 +396,7 @@ end subroutine HDF5_addAttribute_int
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief adds a integer attribute to the path given relative to the location !> @brief Add a real attribute to the path given relative to the location.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path) subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path)
@ -402,6 +410,7 @@ subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path)
logical :: attrExists logical :: attrExists
character(len=:), allocatable :: p character(len=:), allocatable :: p
if (present(path)) then if (present(path)) then
p = trim(path) p = trim(path)
else else
@ -410,6 +419,7 @@ subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path)
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' 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(hdferr < 0) error stop 'HDF5 error'
if (attrExists) then if (attrExists) then
@ -420,6 +430,7 @@ subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path)
if(hdferr < 0) error stop 'HDF5 error' 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' 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' if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(space_id,hdferr) call h5sclose_f(space_id,hdferr)
@ -429,7 +440,67 @@ end subroutine HDF5_addAttribute_real
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief adds a integer attribute to the path given relative to the location !> @brief Add a string array attribute to the path given relative to the location.
!--------------------------------------------------------------------------------------------------
subroutine HDF5_addAttribute_str_array(loc_id,attrLabel,attrValue,path)
integer(HID_T), intent(in) :: loc_id
character(len=*), intent(in) :: attrLabel
character(len=*), intent(in), dimension(:) :: attrValue
character(len=*), intent(in), optional :: path
integer(HID_T) :: attr_id, space_id, filetype_id, memtype_id
integer :: hdferr
logical :: attrExists
character(len=:), allocatable :: p
type(C_PTR) :: f_ptr
character(len=:), allocatable, dimension(:), target :: attrValue_
if (present(path)) then
p = trim(path)
else
p = '.'
endif
attrValue_ = attrValue
call h5tcopy_f(H5T_C_S1,filetype_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5tset_size_f(filetype_id, int(len(attrValue_)+1,C_SIZE_T),hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5tcopy_f(H5T_FORTRAN_S1, memtype_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5tset_size_f(memtype_id, int(len(attrValue_),C_SIZE_T), hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5screate_simple_f(1,shape(attrValue_,kind=HSIZE_T),space_id, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5aexists_by_name_f(loc_id,trim(p),attrLabel,attrExists,hdferr)
if (attrExists) then
call h5adelete_by_name_f(loc_id, trim(p), attrLabel, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
endif
call h5acreate_by_name_f(loc_id,trim(p),trim(attrLabel),filetype_id,space_id,attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
f_ptr = c_loc(attrValue_)
call h5awrite_f(attr_id, memtype_id, f_ptr, hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5tclose_f(memtype_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5tclose_f(filetype_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5aclose_f(attr_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(space_id,hdferr)
if(hdferr < 0) error stop 'HDF5 error'
end subroutine HDF5_addAttribute_str_array
!--------------------------------------------------------------------------------------------------
!> @brief Add an integer array attribute to the path given relative to the location.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path) subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path)
@ -444,6 +515,7 @@ subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path)
logical :: attrExists logical :: attrExists
character(len=:), allocatable :: p character(len=:), allocatable :: p
if (present(path)) then if (present(path)) then
p = trim(path) p = trim(path)
else else
@ -454,6 +526,7 @@ subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path)
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' 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(hdferr < 0) error stop 'HDF5 error'
if (attrExists) then if (attrExists) then
@ -464,6 +537,7 @@ subroutine HDF5_addAttribute_int_array(loc_id,attrLabel,attrValue,path)
if(hdferr < 0) error stop 'HDF5 error' 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' 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' if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(space_id,hdferr) call h5sclose_f(space_id,hdferr)
@ -473,7 +547,7 @@ end subroutine HDF5_addAttribute_int_array
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief adds a real attribute to the path given relative to the location !> @brief Add a real array attribute to the path given relative to the location.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine HDF5_addAttribute_real_array(loc_id,attrLabel,attrValue,path) subroutine HDF5_addAttribute_real_array(loc_id,attrLabel,attrValue,path)
@ -488,6 +562,7 @@ subroutine HDF5_addAttribute_real_array(loc_id,attrLabel,attrValue,path)
logical :: attrExists logical :: attrExists
character(len=:), allocatable :: p character(len=:), allocatable :: p
if (present(path)) then if (present(path)) then
p = trim(path) p = trim(path)
else else
@ -498,6 +573,7 @@ subroutine HDF5_addAttribute_real_array(loc_id,attrLabel,attrValue,path)
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' 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(hdferr < 0) error stop 'HDF5 error'
if (attrExists) then if (attrExists) then
@ -508,6 +584,7 @@ subroutine HDF5_addAttribute_real_array(loc_id,attrLabel,attrValue,path)
if(hdferr < 0) error stop 'HDF5 error' 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' 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' if(hdferr < 0) error stop 'HDF5 error'
call h5sclose_f(space_id,hdferr) call h5sclose_f(space_id,hdferr)
@ -517,7 +594,7 @@ end subroutine HDF5_addAttribute_real_array
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief set link to object in results file !> @brief Set link to object in results file.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine HDF5_setLink(loc_id,target_name,link_name) subroutine HDF5_setLink(loc_id,target_name,link_name)
@ -549,7 +626,7 @@ subroutine HDF5_read_real1(dataset,loc_id,datasetName,parallel)
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & ! ToDo: Fortran 2018 size(shape(A)) = rank(A) integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -589,7 +666,7 @@ subroutine HDF5_read_real2(dataset,loc_id,datasetName,parallel)
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -629,7 +706,7 @@ subroutine HDF5_read_real3(dataset,loc_id,datasetName,parallel)
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -669,7 +746,7 @@ subroutine HDF5_read_real4(dataset,loc_id,datasetName,parallel)
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -709,7 +786,7 @@ subroutine HDF5_read_real5(dataset,loc_id,datasetName,parallel)
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -749,7 +826,7 @@ subroutine HDF5_read_real6(dataset,loc_id,datasetName,parallel)
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -789,7 +866,7 @@ subroutine HDF5_read_real7(dataset,loc_id,datasetName,parallel)
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -831,7 +908,7 @@ subroutine HDF5_read_int1(dataset,loc_id,datasetName,parallel)
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -871,7 +948,7 @@ subroutine HDF5_read_int2(dataset,loc_id,datasetName,parallel)
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -911,7 +988,7 @@ subroutine HDF5_read_int3(dataset,loc_id,datasetName,parallel)
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -951,7 +1028,7 @@ subroutine HDF5_read_int4(dataset,loc_id,datasetName,parallel)
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -991,7 +1068,7 @@ subroutine HDF5_read_int5(dataset,loc_id,datasetName,parallel)
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -1031,7 +1108,7 @@ subroutine HDF5_read_int6(dataset,loc_id,datasetName,parallel)
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -1071,7 +1148,7 @@ subroutine HDF5_read_int7(dataset,loc_id,datasetName,parallel)
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id, aplist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -1114,7 +1191,7 @@ subroutine HDF5_write_real1(dataset,loc_id,datasetName,parallel)
integer :: hdferr integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -1155,7 +1232,7 @@ subroutine HDF5_write_real2(dataset,loc_id,datasetName,parallel)
integer :: hdferr integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -1196,7 +1273,7 @@ subroutine HDF5_write_real3(dataset,loc_id,datasetName,parallel)
integer :: hdferr integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -1237,7 +1314,7 @@ subroutine HDF5_write_real4(dataset,loc_id,datasetName,parallel)
integer :: hdferr integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -1279,7 +1356,7 @@ subroutine HDF5_write_real5(dataset,loc_id,datasetName,parallel)
integer :: hdferr integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -1320,7 +1397,7 @@ subroutine HDF5_write_real6(dataset,loc_id,datasetName,parallel)
integer :: hdferr integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -1361,7 +1438,7 @@ subroutine HDF5_write_real7(dataset,loc_id,datasetName,parallel)
integer :: hdferr integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -1403,7 +1480,7 @@ subroutine HDF5_write_int1(dataset,loc_id,datasetName,parallel)
integer :: hdferr integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -1444,7 +1521,7 @@ subroutine HDF5_write_int2(dataset,loc_id,datasetName,parallel)
integer :: hdferr integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -1485,7 +1562,7 @@ subroutine HDF5_write_int3(dataset,loc_id,datasetName,parallel)
integer :: hdferr integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -1526,7 +1603,7 @@ subroutine HDF5_write_int4(dataset,loc_id,datasetName,parallel)
integer :: hdferr integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -1567,7 +1644,7 @@ subroutine HDF5_write_int5(dataset,loc_id,datasetName,parallel)
integer :: hdferr integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -1608,7 +1685,7 @@ subroutine HDF5_write_int6(dataset,loc_id,datasetName,parallel)
integer :: hdferr integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)
@ -1649,7 +1726,7 @@ subroutine HDF5_write_int7(dataset,loc_id,datasetName,parallel)
integer :: hdferr integer :: hdferr
integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id integer(HID_T) :: dset_id, filespace_id, memspace_id, plist_id
integer(HSIZE_T), dimension(size(shape(dataset))) :: & integer(HSIZE_T), dimension(rank(dataset)) :: &
myStart, & myStart, &
myShape, & !< shape of the dataset (this process) myShape, & !< shape of the dataset (this process)
totalShape !< shape of the dataset (all processes) totalShape !< shape of the dataset (all processes)

16
src/material.f90
View File

@ -8,6 +8,7 @@ module material
use prec use prec
use config use config
use results use results
use math
use IO use IO
use rotations use rotations
use discretization use discretization
@ -19,8 +20,12 @@ module material
type :: tRotationContainer type :: tRotationContainer
type(Rotation), dimension(:), allocatable :: data type(Rotation), dimension(:), allocatable :: data
end type end type
type :: tTensorContainer
real(pReal), dimension(:,:,:), allocatable :: data
end type
type(tRotationContainer), dimension(:), allocatable :: material_orientation0
type(tRotationContainer), dimension(:), allocatable :: material_O_0
integer, dimension(:), allocatable, public, protected :: & integer, dimension(:), allocatable, public, protected :: &
homogenization_Nconstituents !< number of grains in each homogenization homogenization_Nconstituents !< number of grains in each homogenization
@ -41,8 +46,9 @@ module material
integer, dimension(:,:,:), allocatable, public, protected :: & ! (constituent,IP,elem) integer, dimension(:,:,:), allocatable, public, protected :: & ! (constituent,IP,elem)
material_phaseMemberAt !TODO: remove material_phaseMemberAt !TODO: remove
public :: & public :: &
tTensorContainer, &
tRotationContainer, & tRotationContainer, &
material_orientation0, & material_O_0, &
material_init material_init
contains contains
@ -152,15 +158,15 @@ subroutine parse()
enddo enddo
allocate(material_orientation0(materials%length)) allocate(material_O_0(materials%length))
do ma = 1, materials%length do ma = 1, materials%length
material => materials%get(ma) material => materials%get(ma)
constituents => material%get('constituents') constituents => material%get('constituents')
allocate(material_orientation0(ma)%data(constituents%length)) allocate(material_O_0(ma)%data(constituents%length))
do co = 1, constituents%length do co = 1, constituents%length
constituent => constituents%get(co) constituent => constituents%get(co)
call material_orientation0(ma)%data(co)%fromQuaternion(constituent%get_as1dFloat('O',requiredSize=4)) call material_O_0(ma)%data(co)%fromQuaternion(constituent%get_as1dFloat('O',requiredSize=4))
enddo enddo
enddo enddo

13
src/math.f90
View File

@ -545,19 +545,6 @@ pure function math_symmetric33(m)
end function math_symmetric33 end function math_symmetric33
!--------------------------------------------------------------------------------------------------
!> @brief symmetrize a 6x6 matrix
!--------------------------------------------------------------------------------------------------
pure function math_symmetric66(m)
real(pReal), dimension(6,6) :: math_symmetric66
real(pReal), dimension(6,6), intent(in) :: m
math_symmetric66 = 0.5_pReal * (m + transpose(m))
end function math_symmetric66
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief skew part of a 3x3 matrix !> @brief skew part of a 3x3 matrix
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------

24
src/phase.f90
View File

@ -26,12 +26,8 @@ module phase
real(pReal), allocatable, dimension(:) :: phase_rho real(pReal), allocatable, dimension(:) :: phase_rho
type(tRotationContainer), dimension(:), allocatable :: & type(tRotationContainer), dimension(:), allocatable :: &
phase_orientation0, & phase_O_0, &
phase_orientation phase_O
type :: tTensorContainer
real(pReal), dimension(:,:,:), allocatable :: data
end type
type :: tNumerics type :: tNumerics
integer :: & integer :: &
@ -364,7 +360,7 @@ subroutine phase_init
allocate(phase_lattice(phases%length)) allocate(phase_lattice(phases%length))
allocate(phase_cOverA(phases%length),source=-1.0_pReal) allocate(phase_cOverA(phases%length),source=-1.0_pReal)
allocate(phase_rho(phases%length)) allocate(phase_rho(phases%length))
allocate(phase_orientation0(phases%length)) allocate(phase_O_0(phases%length))
do ph = 1,phases%length do ph = 1,phases%length
phase => phases%get(ph) phase => phases%get(ph)
@ -374,20 +370,20 @@ subroutine phase_init
if (any(phase_lattice(ph) == ['hP','tI'])) & if (any(phase_lattice(ph) == ['hP','tI'])) &
phase_cOverA(ph) = phase%get_asFloat('c/a') phase_cOverA(ph) = phase%get_asFloat('c/a')
phase_rho(ph) = phase%get_asFloat('rho',defaultVal=0.0_pReal) phase_rho(ph) = phase%get_asFloat('rho',defaultVal=0.0_pReal)
allocate(phase_orientation0(ph)%data(count(material_phaseID==ph))) allocate(phase_O_0(ph)%data(count(material_phaseID==ph)))
enddo enddo
do ce = 1, size(material_phaseID,2) do ce = 1, size(material_phaseID,2)
ma = discretization_materialAt((ce-1)/discretization_nIPs+1) ma = discretization_materialAt((ce-1)/discretization_nIPs+1)
do co = 1,homogenization_Nconstituents(material_homogenizationID(ce)) do co = 1,homogenization_Nconstituents(material_homogenizationID(ce))
ph = material_phaseID(co,ce) ph = material_phaseID(co,ce)
phase_orientation0(ph)%data(material_phaseEntry(co,ce)) = material_orientation0(ma)%data(co) phase_O_0(ph)%data(material_phaseEntry(co,ce)) = material_O_0(ma)%data(co)
enddo enddo
enddo enddo
allocate(phase_orientation(phases%length)) allocate(phase_O(phases%length))
do ph = 1,phases%length do ph = 1,phases%length
phase_orientation(ph)%data = phase_orientation0(ph)%data phase_O(ph)%data = phase_O_0(ph)%data
enddo enddo
call mechanical_init(materials,phases) call mechanical_init(materials,phases)
@ -577,10 +573,10 @@ subroutine crystallite_orientations(co,ip,el)
ph = material_phaseID(co,(el-1)*discretization_nIPs + ip) ph = material_phaseID(co,(el-1)*discretization_nIPs + ip)
en = material_phaseEntry(co,(el-1)*discretization_nIPs + ip) en = material_phaseEntry(co,(el-1)*discretization_nIPs + ip)
call phase_orientation(ph)%data(en)%fromMatrix(transpose(math_rotationalPart(mechanical_F_e(ph,en)))) call phase_O(ph)%data(en)%fromMatrix(transpose(math_rotationalPart(mechanical_F_e(ph,en))))
if (plasticState(material_phaseAt(1,el))%nonlocal) & if (plasticState(material_phaseAt(1,el))%nonlocal) &
call plastic_nonlocal_updateCompatibility(phase_orientation,material_phaseAt(1,el),ip,el) call plastic_nonlocal_updateCompatibility(phase_O,material_phaseAt(1,el),ip,el)
end subroutine crystallite_orientations end subroutine crystallite_orientations
@ -602,7 +598,7 @@ function crystallite_push33ToRef(co,ce, tensor33)
ph = material_phaseID(co,ce) ph = material_phaseID(co,ce)
en = material_phaseEntry(co,ce) en = material_phaseEntry(co,ce)
T = matmul(phase_orientation0(ph)%data(en)%asMatrix(),transpose(math_inv33(phase_F(co,ce)))) ! ToDo: initial orientation correct? T = matmul(phase_O_0(ph)%data(en)%asMatrix(),transpose(math_inv33(phase_F(co,ce)))) ! ToDo: initial orientation correct?
crystallite_push33ToRef = matmul(transpose(T),matmul(tensor33,T)) crystallite_push33ToRef = matmul(transpose(T),matmul(tensor33,T))

22
src/phase_mechanical.f90
View File

@ -265,7 +265,7 @@ module subroutine mechanical_init(materials,phases)
do ph = 1, phases%length do ph = 1, phases%length
do en = 1, count(material_phaseID == ph) do en = 1, count(material_phaseID == ph)
phase_mechanical_Fp0(ph)%data(1:3,1:3,en) = phase_orientation0(ph)%data(en)%asMatrix() ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005) phase_mechanical_Fp0(ph)%data(1:3,1:3,en) = phase_O_0(ph)%data(en)%asMatrix() ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005)
phase_mechanical_Fp0(ph)%data(1:3,1:3,en) = phase_mechanical_Fp0(ph)%data(1:3,1:3,en) & phase_mechanical_Fp0(ph)%data(1:3,1:3,en) = phase_mechanical_Fp0(ph)%data(1:3,1:3,en) &
/ math_det33(phase_mechanical_Fp0(ph)%data(1:3,1:3,en))**(1.0_pReal/3.0_pReal) / math_det33(phase_mechanical_Fp0(ph)%data(1:3,1:3,en))**(1.0_pReal/3.0_pReal)
phase_mechanical_Fi0(ph)%data(1:3,1:3,en) = math_I3 phase_mechanical_Fi0(ph)%data(1:3,1:3,en) = math_I3
@ -902,7 +902,6 @@ subroutine crystallite_results(group,ph)
integer, intent(in) :: ph integer, intent(in) :: ph
integer :: ou integer :: ou
real(pReal), allocatable, dimension(:,:) :: selected_rotations
call results_closeGroup(results_addGroup(group//'/mechanical')) call results_closeGroup(results_addGroup(group//'/mechanical'))
@ -935,8 +934,7 @@ subroutine crystallite_results(group,ph)
call results_writeDataset(phase_mechanical_S(ph)%data,group//'/mechanical/','S', & call results_writeDataset(phase_mechanical_S(ph)%data,group//'/mechanical/','S', &
'second Piola-Kirchhoff stress','Pa') 'second Piola-Kirchhoff stress','Pa')
case('O') case('O')
selected_rotations = select_rotations(phase_orientation(ph)%data) call results_writeDataset(to_quaternion(phase_O(ph)%data),group//'/mechanical',output_constituent(ph)%label(ou),&
call results_writeDataset(selected_rotations,group//'/mechanical',output_constituent(ph)%label(ou),&
'crystal orientation as quaternion','q_0 (q_1 q_2 q_3)') 'crystal orientation as quaternion','q_0 (q_1 q_2 q_3)')
call results_addAttribute('lattice',phase_lattice(ph),group//'/mechanical/'//output_constituent(ph)%label(ou)) call results_addAttribute('lattice',phase_lattice(ph),group//'/mechanical/'//output_constituent(ph)%label(ou))
if (any(phase_lattice(ph) == ['hP', 'tI'])) & if (any(phase_lattice(ph) == ['hP', 'tI'])) &
@ -948,19 +946,21 @@ subroutine crystallite_results(group,ph)
contains contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Convert orientation for output: ToDo: implement in HDF5/results !> @brief Convert orientation array to quaternion array
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function select_rotations(dataset) function to_quaternion(dataset)
type(rotation), dimension(:), intent(in) :: dataset type(rotation), dimension(:), intent(in) :: dataset
real(pReal), dimension(4,size(dataset,1)) :: select_rotations real(pReal), dimension(4,size(dataset,1)) :: to_quaternion
integer :: en
do en = 1, size(dataset,1) integer :: i
select_rotations(:,en) = dataset(en)%asQuaternion()
do i = 1, size(dataset,1)
to_quaternion(:,i) = dataset(i)%asQuaternion()
enddo enddo
end function select_rotations end function to_quaternion
end subroutine crystallite_results end subroutine crystallite_results

4
src/phase_mechanical_plastic_nonlocal.f90
View File

@ -1402,8 +1402,8 @@ module subroutine plastic_nonlocal_updateCompatibility(orientation,ph,i,e)
forall(s1 = 1:ns) my_compatibility(:,s1,s1,n) = 0.0_pReal forall(s1 = 1:ns) my_compatibility(:,s1,s1,n) = 0.0_pReal
elseif (prm%chi_GB >= 0.0_pReal) then elseif (prm%chi_GB >= 0.0_pReal) then
!* GRAIN BOUNDARY !* GRAIN BOUNDARY
if (any(dNeq(phase_orientation0(ph)%data(en)%asQuaternion(), & if (any(dNeq(phase_O_0(ph)%data(en)%asQuaternion(), &
phase_orientation0(neighbor_phase)%data(neighbor_me)%asQuaternion())) .and. & phase_O_0(neighbor_phase)%data(neighbor_me)%asQuaternion())) .and. &
plasticState(neighbor_phase)%nonlocal) & plasticState(neighbor_phase)%nonlocal) &
forall(s1 = 1:ns) my_compatibility(:,s1,s1,n) = sqrt(prm%chi_GB) forall(s1 = 1:ns) my_compatibility(:,s1,s1,n) = sqrt(prm%chi_GB)
else else