diff --git a/PRIVATE b/PRIVATE
index 22a23a9d5..4cd6c7350 160000
--- a/PRIVATE
+++ b/PRIVATE
@@ -1 +1 @@
-Subproject commit 22a23a9d5939d49d9d277c7066d9b68003a33324
+Subproject commit 4cd6c7350b0a9d4ad3efcb5fe6c6cfffa99c426f
diff --git a/VERSION b/VERSION
index 495329abd..a41a3d48a 100644
--- a/VERSION
+++ b/VERSION
@@ -1 +1 @@
-3.0.0-alpha7-534-g51210a05e
+3.0.0-alpha7-544-g58ee3312c
diff --git a/src/CLI.f90 b/src/CLI.f90
index bc735af40..6058ce2b2 100644
--- a/src/CLI.f90
+++ b/src/CLI.f90
@@ -43,7 +43,7 @@ subroutine CLI_init
-- UNSUPPORTED PETSc VERSION --- UNSUPPORTED PETSc VERSION --- UNSUPPORTED PETSc VERSION ---
#endif
- character(len=pPathLen*3+pStringLen) :: &
+ character(len=pPathLen*3+pSTRLEN) :: &
commandLine !< command line call as string
character(len=pPathLen) :: &
arg, & !< individual argument
diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90
index 936b224e8..857fd30d1 100644
--- a/src/HDF5_utilities.f90
+++ b/src/HDF5_utilities.f90
@@ -28,7 +28,7 @@ module HDF5_utilities
private
!--------------------------------------------------------------------------------------------------
-!> @brief Read integer or float data of defined shape from file.
+!> @brief Read integer or real data of defined shape from file.
!> @details for parallel IO, all dimension except for the last need to match
!--------------------------------------------------------------------------------------------------
interface HDF5_read
@@ -135,8 +135,8 @@ subroutine HDF5_utilities_init()
call H5Tget_size_f(H5T_NATIVE_DOUBLE,typeSize, hdferr)
call HDF5_chkerr(hdferr)
- if (int(storage_size(0.0_pReal),SIZE_T)/=typeSize*8) &
- error stop 'pReal does not match H5T_NATIVE_DOUBLE'
+ if (int(storage_size(0.0_pREAL),SIZE_T)/=typeSize*8) &
+ error stop 'pREAL does not match H5T_NATIVE_DOUBLE'
call H5get_libversion_f(HDF5_major,HDF5_minor,HDF5_release,hdferr)
call HDF5_chkerr(hdferr)
@@ -443,7 +443,7 @@ subroutine HDF5_addAttribute_real(loc_id,attrLabel,attrValue,path)
integer(HID_T), intent(in) :: loc_id
character(len=*), intent(in) :: attrLabel
- real(pReal), intent(in) :: attrValue
+ real(pREAL), intent(in) :: attrValue
character(len=*), intent(in), optional :: path
integer(HID_T) :: attr_id, space_id
@@ -576,7 +576,7 @@ subroutine HDF5_addAttribute_real_array(loc_id,attrLabel,attrValue,path)
integer(HID_T), intent(in) :: loc_id
character(len=*), intent(in) :: attrLabel
- real(pReal), intent(in), dimension(:) :: attrValue
+ real(pREAL), intent(in), dimension(:) :: attrValue
character(len=*), intent(in), optional :: path
integer(HSIZE_T),dimension(1) :: array_size
@@ -640,7 +640,7 @@ end subroutine HDF5_setLink
!--------------------------------------------------------------------------------------------------
subroutine HDF5_read_real1(dataset,loc_id,datasetName,parallel)
- real(pReal), intent(out), dimension(:) :: dataset !< data read from file
+ real(pREAL), intent(out), dimension(:) :: dataset !< data read from file
integer(HID_T), intent(in) :: loc_id !< file or group handle
character(len=*), intent(in) :: datasetName !< name of the dataset in the file
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
@@ -674,7 +674,7 @@ end subroutine HDF5_read_real1
!--------------------------------------------------------------------------------------------------
subroutine HDF5_read_real2(dataset,loc_id,datasetName,parallel)
- real(pReal), intent(out), dimension(:,:) :: dataset !< data read from file
+ real(pREAL), intent(out), dimension(:,:) :: dataset !< data read from file
integer(HID_T), intent(in) :: loc_id !< file or group handle
character(len=*), intent(in) :: datasetName !< name of the dataset in the file
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
@@ -708,7 +708,7 @@ end subroutine HDF5_read_real2
!--------------------------------------------------------------------------------------------------
subroutine HDF5_read_real3(dataset,loc_id,datasetName,parallel)
- real(pReal), intent(out), dimension(:,:,:) :: dataset !< data read from file
+ real(pREAL), intent(out), dimension(:,:,:) :: dataset !< data read from file
integer(HID_T), intent(in) :: loc_id !< file or group handle
character(len=*), intent(in) :: datasetName !< name of the dataset in the file
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
@@ -742,7 +742,7 @@ end subroutine HDF5_read_real3
!--------------------------------------------------------------------------------------------------
subroutine HDF5_read_real4(dataset,loc_id,datasetName,parallel)
- real(pReal), intent(out), dimension(:,:,:,:) :: dataset !< read data
+ real(pREAL), intent(out), dimension(:,:,:,:) :: dataset !< read data
integer(HID_T), intent(in) :: loc_id !< file or group handle
character(len=*), intent(in) :: datasetName !< name of the dataset in the file
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
@@ -777,7 +777,7 @@ end subroutine HDF5_read_real4
!--------------------------------------------------------------------------------------------------
subroutine HDF5_read_real5(dataset,loc_id,datasetName,parallel)
- real(pReal), intent(out), dimension(:,:,:,:,:) :: dataset !< data read from file
+ real(pREAL), intent(out), dimension(:,:,:,:,:) :: dataset !< data read from file
integer(HID_T), intent(in) :: loc_id !< file or group handle
character(len=*), intent(in) :: datasetName !< name of the dataset in the file
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
@@ -812,7 +812,7 @@ end subroutine HDF5_read_real5
!--------------------------------------------------------------------------------------------------
subroutine HDF5_read_real6(dataset,loc_id,datasetName,parallel)
- real(pReal), intent(out), dimension(:,:,:,:,:,:) :: dataset !< data read from file
+ real(pREAL), intent(out), dimension(:,:,:,:,:,:) :: dataset !< data read from file
integer(HID_T), intent(in) :: loc_id !< file or group handle
character(len=*), intent(in) :: datasetName !< name of the dataset in the file
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
@@ -847,7 +847,7 @@ end subroutine HDF5_read_real6
!--------------------------------------------------------------------------------------------------
subroutine HDF5_read_real7(dataset,loc_id,datasetName,parallel)
- real(pReal), intent(out), dimension(:,:,:,:,:,:,:) :: dataset !< data read from file
+ real(pREAL), intent(out), dimension(:,:,:,:,:,:,:) :: dataset !< data read from file
integer(HID_T), intent(in) :: loc_id !< file or group handle
character(len=*), intent(in) :: datasetName !< name of the dataset in the file
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
@@ -1126,7 +1126,7 @@ end subroutine HDF5_read_int7
!--------------------------------------------------------------------------------------------------
subroutine HDF5_write_real1(dataset,loc_id,datasetName,parallel)
- real(pReal), intent(in), dimension(:) :: dataset !< data written to file
+ real(pREAL), intent(in), dimension(:) :: dataset !< data written to file
integer(HID_T), intent(in) :: loc_id !< file or group handle
character(len=*), intent(in) :: datasetName !< name of the dataset in the file
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
@@ -1163,7 +1163,7 @@ end subroutine HDF5_write_real1
!--------------------------------------------------------------------------------------------------
subroutine HDF5_write_real2(dataset,loc_id,datasetName,parallel)
- real(pReal), intent(in), dimension(:,:) :: dataset !< data written to file
+ real(pREAL), intent(in), dimension(:,:) :: dataset !< data written to file
integer(HID_T), intent(in) :: loc_id !< file or group handle
character(len=*), intent(in) :: datasetName !< name of the dataset in the file
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
@@ -1200,7 +1200,7 @@ end subroutine HDF5_write_real2
!--------------------------------------------------------------------------------------------------
subroutine HDF5_write_real3(dataset,loc_id,datasetName,parallel)
- real(pReal), intent(in), dimension(:,:,:) :: dataset !< data written to file
+ real(pREAL), intent(in), dimension(:,:,:) :: dataset !< data written to file
integer(HID_T), intent(in) :: loc_id !< file or group handle
character(len=*), intent(in) :: datasetName !< name of the dataset in the file
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
@@ -1237,7 +1237,7 @@ end subroutine HDF5_write_real3
!--------------------------------------------------------------------------------------------------
subroutine HDF5_write_real4(dataset,loc_id,datasetName,parallel)
- real(pReal), intent(in), dimension(:,:,:,:) :: dataset !< data written to file
+ real(pREAL), intent(in), dimension(:,:,:,:) :: dataset !< data written to file
integer(HID_T), intent(in) :: loc_id !< file or group handle
character(len=*), intent(in) :: datasetName !< name of the dataset in the file
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
@@ -1275,7 +1275,7 @@ end subroutine HDF5_write_real4
!--------------------------------------------------------------------------------------------------
subroutine HDF5_write_real5(dataset,loc_id,datasetName,parallel)
- real(pReal), intent(in), dimension(:,:,:,:,:) :: dataset !< data written to file
+ real(pREAL), intent(in), dimension(:,:,:,:,:) :: dataset !< data written to file
integer(HID_T), intent(in) :: loc_id !< file or group handle
character(len=*), intent(in) :: datasetName !< name of the dataset in the file
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
@@ -1312,7 +1312,7 @@ end subroutine HDF5_write_real5
!--------------------------------------------------------------------------------------------------
subroutine HDF5_write_real6(dataset,loc_id,datasetName,parallel)
- real(pReal), intent(in), dimension(:,:,:,:,:,:) :: dataset !< data written to file
+ real(pREAL), intent(in), dimension(:,:,:,:,:,:) :: dataset !< data written to file
integer(HID_T), intent(in) :: loc_id !< file or group handle
character(len=*), intent(in) :: datasetName !< name of the dataset in the file
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
@@ -1349,7 +1349,7 @@ end subroutine HDF5_write_real6
!--------------------------------------------------------------------------------------------------
subroutine HDF5_write_real7(dataset,loc_id,datasetName,parallel)
- real(pReal), intent(in), dimension(:,:,:,:,:,:,:) :: dataset !< data written to file
+ real(pREAL), intent(in), dimension(:,:,:,:,:,:,:) :: dataset !< data written to file
integer(HID_T), intent(in) :: loc_id !< file or group handle
character(len=*), intent(in) :: datasetName !< name of the dataset in the file
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
@@ -1388,7 +1388,7 @@ end subroutine HDF5_write_real7
!--------------------------------------------------------------------------------------------------
subroutine HDF5_write_real(dataset,loc_id,datasetName,parallel)
- real(pReal), intent(in), dimension(..) :: dataset !< data written to file
+ real(pREAL), intent(in), dimension(..) :: dataset !< data written to file
integer(HID_T), intent(in) :: loc_id !< file or group handle
character(len=*), intent(in) :: datasetName !< name of the dataset in the file
logical, intent(in), optional :: parallel !< dataset is distributed over multiple processes
diff --git a/src/IO.f90 b/src/IO.f90
index 882b7faf6..27e650825 100644
--- a/src/IO.f90
+++ b/src/IO.f90
@@ -32,16 +32,16 @@ module IO
IO_readlines, &
IO_isBlank, &
IO_wrapLines, &
- IO_stringPos, &
- IO_stringValue, &
+ IO_strPos, &
+ IO_strValue, &
IO_intValue, &
- IO_floatValue, &
+ IO_realValue, &
IO_lc, &
IO_rmComment, &
- IO_intAsString, &
- IO_stringAsInt, &
- IO_stringAsFloat, &
- IO_stringAsBool, &
+ IO_intAsStr, &
+ IO_strAsInt, &
+ IO_strAsReal, &
+ IO_strAsBool, &
IO_error, &
IO_warning, &
IO_STDOUT
@@ -66,11 +66,11 @@ end subroutine IO_init
!--------------------------------------------------------------------------------------------------
function IO_readlines(fileName) result(fileContent)
- character(len=*), intent(in) :: fileName
- character(len=pStringLen), dimension(:), allocatable :: fileContent !< file content, separated per lines
+ character(len=*), intent(in) :: fileName
+ character(len=pSTRLEN), dimension(:), allocatable :: fileContent !< file content, separated per lines
- character(len=pStringLen) :: line
- character(len=:), allocatable :: rawData
+ character(len=pSTRLEN) :: line
+ character(len=:), allocatable :: rawData
integer :: &
startPos, endPos, &
N_lines, & !< # lines in file
@@ -90,8 +90,8 @@ function IO_readlines(fileName) result(fileContent)
l = 1
do while (l <= N_lines)
endPos = startPos + scan(rawData(startPos:),IO_EOL) - 2
- if (endPos - startPos > pStringLen-1) then
- line = rawData(startPos:startPos+pStringLen-1)
+ if (endPos - startPos > pSTRLEN-1) then
+ line = rawData(startPos:startPos+pSTRLEN-1)
if (.not. warned) then
call IO_warning(207,trim(fileName),label1='line',ID1=l)
warned = .true.
@@ -147,15 +147,15 @@ end function IO_read
!--------------------------------------------------------------------------------------------------
!> @brief Identifiy strings without content.
!--------------------------------------------------------------------------------------------------
-logical pure function IO_isBlank(string)
+logical pure function IO_isBlank(str)
- character(len=*), intent(in) :: string !< string to check for content
+ character(len=*), intent(in) :: str !< string to check for content
integer :: posNonBlank
- posNonBlank = verify(string,IO_WHITESPACE)
- IO_isBlank = posNonBlank == 0 .or. posNonBlank == scan(string,IO_COMMENT)
+ posNonBlank = verify(str,IO_WHITESPACE)
+ IO_isBlank = posNonBlank == 0 .or. posNonBlank == scan(str,IO_COMMENT)
end function IO_isBlank
@@ -163,9 +163,9 @@ end function IO_isBlank
!--------------------------------------------------------------------------------------------------
!> @brief Insert EOL at separator trying to keep line length below limit.
!--------------------------------------------------------------------------------------------------
-function IO_wrapLines(string,separator,filler,length)
+function IO_wrapLines(str,separator,filler,length)
- character(len=*), intent(in) :: string !< string to split
+ character(len=*), intent(in) :: str !< string to split
character, optional, intent(in) :: separator !< line breaks are possible after this character, defaults to ','
character(len=*), optional, intent(in) :: filler !< character(s) to insert after line break, defaults to none
integer, optional, intent(in) :: length !< (soft) line limit, defaults to 80
@@ -175,18 +175,18 @@ function IO_wrapLines(string,separator,filler,length)
integer :: i,s,e
- i = index(string,misc_optional(separator,','))
+ i = index(str,misc_optional(separator,','))
if (i == 0) then
- IO_wrapLines = string
+ IO_wrapLines = str
else
pos_sep = [0]
s = i
- do while (i /= 0 .and. s < len(string))
+ do while (i /= 0 .and. s < len(str))
pos_sep = [pos_sep,s]
- i = index(string(s+1:),misc_optional(separator,','))
+ i = index(str(s+1:),misc_optional(separator,','))
s = s + i
end do
- pos_sep = [pos_sep,len(string)]
+ pos_sep = [pos_sep,len(str)]
pos_split = emptyIntArray
s = 1
@@ -194,12 +194,12 @@ function IO_wrapLines(string,separator,filler,length)
IO_wrapLines = ''
do while (e < size(pos_sep))
if (pos_sep(e+1) - pos_sep(s) >= misc_optional(length,80)) then
- IO_wrapLines = IO_wrapLines//adjustl(string(pos_sep(s)+1:pos_sep(e)))//IO_EOL//misc_optional(filler,'')
+ IO_wrapLines = IO_wrapLines//adjustl(str(pos_sep(s)+1:pos_sep(e)))//IO_EOL//misc_optional(filler,'')
s = e
end if
e = e + 1
end do
- IO_wrapLines = IO_wrapLines//adjustl(string(pos_sep(s)+1:))
+ IO_wrapLines = IO_wrapLines//adjustl(str(pos_sep(s)+1:))
end if
end function IO_wrapLines
@@ -211,87 +211,87 @@ end function IO_wrapLines
!! Array size is dynamically adjusted to number of chunks found in string
!! IMPORTANT: first element contains number of chunks!
!--------------------------------------------------------------------------------------------------
-pure function IO_stringPos(string)
+pure function IO_strPos(str)
- character(len=*), intent(in) :: string !< string in which chunk positions are searched for
- integer, dimension(:), allocatable :: IO_stringPos
+ character(len=*), intent(in) :: str !< string in which chunk positions are searched for
+ integer, dimension(:), allocatable :: IO_strPos
integer :: left, right
- allocate(IO_stringPos(1), source=0)
+ allocate(IO_strPos(1), source=0)
right = 0
- do while (verify(string(right+1:),IO_WHITESPACE)>0)
- left = right + verify(string(right+1:),IO_WHITESPACE)
- right = left + scan(string(left:),IO_WHITESPACE) - 2
- if ( string(left:left) == IO_COMMENT) exit
- IO_stringPos = [IO_stringPos,left,right]
- IO_stringPos(1) = IO_stringPos(1)+1
- endOfString: if (right < left) then
- IO_stringPos(IO_stringPos(1)*2+1) = len_trim(string)
+ do while (verify(str(right+1:),IO_WHITESPACE)>0)
+ left = right + verify(str(right+1:),IO_WHITESPACE)
+ right = left + scan(str(left:),IO_WHITESPACE) - 2
+ if ( str(left:left) == IO_COMMENT) exit
+ IO_strPos = [IO_strPos,left,right]
+ IO_strPos(1) = IO_strPos(1)+1
+ endOfStr: if (right < left) then
+ IO_strPos(IO_strPos(1)*2+1) = len_trim(str)
exit
- end if endOfString
+ end if endOfStr
end do
-end function IO_stringPos
+end function IO_strPos
!--------------------------------------------------------------------------------------------------
!> @brief Read string value at myChunk from string.
!--------------------------------------------------------------------------------------------------
-function IO_stringValue(string,chunkPos,myChunk)
+function IO_strValue(str,chunkPos,myChunk)
- character(len=*), intent(in) :: string !< raw input with known start and end of each chunk
+ character(len=*), intent(in) :: str !< raw input with known start and end of each chunk
integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string
integer, intent(in) :: myChunk !< position number of desired chunk
- character(len=:), allocatable :: IO_stringValue
+ character(len=:), allocatable :: IO_strValue
validChunk: if (myChunk > chunkPos(1) .or. myChunk < 1) then
- IO_stringValue = ''
- call IO_error(110,'IO_stringValue: "'//trim(string)//'"',label1='chunk',ID1=myChunk)
+ IO_strValue = ''
+ call IO_error(110,'IO_strValue: "'//trim(str)//'"',label1='chunk',ID1=myChunk)
else validChunk
- IO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1))
+ IO_strValue = str(chunkPos(myChunk*2):chunkPos(myChunk*2+1))
end if validChunk
-end function IO_stringValue
+end function IO_strValue
!--------------------------------------------------------------------------------------------------
!> @brief Read integer value at myChunk from string.
!--------------------------------------------------------------------------------------------------
-integer function IO_intValue(string,chunkPos,myChunk)
+integer function IO_intValue(str,chunkPos,myChunk)
- character(len=*), intent(in) :: string !< raw input with known start and end of each chunk
+ character(len=*), intent(in) :: str !< raw input with known start and end of each chunk
integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string
integer, intent(in) :: myChunk !< position number of desired chunk
- IO_intValue = IO_stringAsInt(IO_stringValue(string,chunkPos,myChunk))
+ IO_intValue = IO_strAsInt(IO_strValue(str,chunkPos,myChunk))
end function IO_intValue
!--------------------------------------------------------------------------------------------------
-!> @brief Read float value at myChunk from string.
+!> @brief Read real value at myChunk from string.
!--------------------------------------------------------------------------------------------------
-real(pReal) function IO_floatValue(string,chunkPos,myChunk)
+real(pREAL) function IO_realValue(str,chunkPos,myChunk)
- character(len=*), intent(in) :: string !< raw input with known start and end of each chunk
+ character(len=*), intent(in) :: str !< raw input with known start and end of each chunk
integer, dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string
integer, intent(in) :: myChunk !< position number of desired chunk
- IO_floatValue = IO_stringAsFloat(IO_stringValue(string,chunkPos,myChunk))
+ IO_realValue = IO_strAsReal(IO_strValue(str,chunkPos,myChunk))
-end function IO_floatValue
+end function IO_realValue
!--------------------------------------------------------------------------------------------------
!> @brief Convert characters in string to lower case.
!--------------------------------------------------------------------------------------------------
-pure function IO_lc(string)
+pure function IO_lc(str)
- character(len=*), intent(in) :: string !< string to convert
- character(len=len(string)) :: IO_lc
+ character(len=*), intent(in) :: str !< string to convert
+ character(len=len(str)) :: IO_lc
character(len=*), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz'
character(len=len(LOWER)), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
@@ -299,10 +299,10 @@ pure function IO_lc(string)
integer :: i,n
- do i = 1,len(string)
- n = index(UPPER,string(i:i))
+ do i = 1,len(str)
+ n = index(UPPER,str(i:i))
if (n==0) then
- IO_lc(i:i) = string(i:i)
+ IO_lc(i:i) = str(i:i)
else
IO_lc(i:i) = LOWER(n:n)
end if
@@ -336,80 +336,80 @@ end function IO_rmComment
!--------------------------------------------------------------------------------------------------
!> @brief Return given int value as string.
!--------------------------------------------------------------------------------------------------
-function IO_intAsString(i)
+function IO_intAsStr(i)
integer, intent(in) :: i
- character(len=:), allocatable :: IO_intAsString
+ character(len=:), allocatable :: IO_intAsStr
- allocate(character(len=merge(2,1,i<0) + floor(log10(real(abs(merge(1,i,i==0))))))::IO_intAsString)
- write(IO_intAsString,'(i0)') i
+ allocate(character(len=merge(2,1,i<0) + floor(log10(real(abs(merge(1,i,i==0))))))::IO_intAsStr)
+ write(IO_intAsStr,'(i0)') i
-end function IO_intAsString
+end function IO_intAsStr
!--------------------------------------------------------------------------------------------------
!> @brief Return integer value from given string.
!--------------------------------------------------------------------------------------------------
-integer function IO_stringAsInt(string)
+integer function IO_strAsInt(str)
- character(len=*), intent(in) :: string !< string for conversion to int value
+ character(len=*), intent(in) :: str !< string for conversion to int value
integer :: readStatus
character(len=*), parameter :: VALIDCHARS = '0123456789+- '
- valid: if (verify(string,VALIDCHARS) == 0) then
- read(string,*,iostat=readStatus) IO_stringAsInt
- if (readStatus /= 0) call IO_error(111,string)
+ valid: if (verify(str,VALIDCHARS) == 0) then
+ read(str,*,iostat=readStatus) IO_strAsInt
+ if (readStatus /= 0) call IO_error(111,str)
else valid
- IO_stringAsInt = 0
- call IO_error(111,string)
+ IO_strAsInt = 0
+ call IO_error(111,str)
end if valid
-end function IO_stringAsInt
+end function IO_strAsInt
!--------------------------------------------------------------------------------------------------
-!> @brief Return float value from given string.
+!> @brief Return real value from given string.
!--------------------------------------------------------------------------------------------------
-real(pReal) function IO_stringAsFloat(string)
+real(pREAL) function IO_strAsReal(str)
- character(len=*), intent(in) :: string !< string for conversion to float value
+ character(len=*), intent(in) :: str !< string for conversion to real value
integer :: readStatus
character(len=*), parameter :: VALIDCHARS = '0123456789eE.+- '
- valid: if (verify(string,VALIDCHARS) == 0) then
- read(string,*,iostat=readStatus) IO_stringAsFloat
- if (readStatus /= 0) call IO_error(112,string)
+ valid: if (verify(str,VALIDCHARS) == 0) then
+ read(str,*,iostat=readStatus) IO_strAsReal
+ if (readStatus /= 0) call IO_error(112,str)
else valid
- IO_stringAsFloat = 0.0_pReal
- call IO_error(112,string)
+ IO_strAsReal = 0.0_pREAL
+ call IO_error(112,str)
end if valid
-end function IO_stringAsFloat
+end function IO_strAsReal
!--------------------------------------------------------------------------------------------------
!> @brief Return logical value from given string.
!--------------------------------------------------------------------------------------------------
-logical function IO_stringAsBool(string)
+logical function IO_strAsBool(str)
- character(len=*), intent(in) :: string !< string for conversion to int value
+ character(len=*), intent(in) :: str !< string for conversion to int value
- if (trim(adjustl(string)) == 'True' .or. trim(adjustl(string)) == 'true') then
- IO_stringAsBool = .true.
- elseif (trim(adjustl(string)) == 'False' .or. trim(adjustl(string)) == 'false') then
- IO_stringAsBool = .false.
+ if (trim(adjustl(str)) == 'True' .or. trim(adjustl(str)) == 'true') then
+ IO_strAsBool = .true.
+ elseif (trim(adjustl(str)) == 'False' .or. trim(adjustl(str)) == 'false') then
+ IO_strAsBool = .false.
else
- IO_stringAsBool = .false.
- call IO_error(113,string)
+ IO_strAsBool = .false.
+ call IO_error(113,str)
end if
-end function IO_stringAsBool
+end function IO_strAsBool
@@ -441,7 +441,7 @@ subroutine IO_error(error_ID,ext_msg,label1,ID1,label2,ID2)
case (111)
msg = 'invalid character for int:'
case (112)
- msg = 'invalid character for float:'
+ msg = 'invalid character for real:'
case (113)
msg = 'invalid character for logical:'
case (114)
@@ -647,22 +647,22 @@ end subroutine IO_warning
!--------------------------------------------------------------------------------------------------
!> @brief Convert Windows (CRLF) to Unix (LF) line endings.
!--------------------------------------------------------------------------------------------------
-pure function CRLF2LF(string)
+pure function CRLF2LF(str)
- character(len=*), intent(in) :: string
+ character(len=*), intent(in) :: str
character(len=:), allocatable :: CRLF2LF
integer(pI64) :: c,n
- allocate(character(len=len_trim(string,pI64))::CRLF2LF)
+ allocate(character(len=len_trim(str,pI64))::CRLF2LF)
if (len(CRLF2LF,pI64) == 0) return
n = 0_pI64
- do c=1_pI64, len_trim(string,pI64)
- CRLF2LF(c-n:c-n) = string(c:c)
- if (c == len_trim(string,pI64)) exit
- if (string(c:c+1_pI64) == CR//LF) n = n + 1_pI64
+ do c=1_pI64, len_trim(str,pI64)
+ CRLF2LF(c-n:c-n) = str(c:c)
+ if (c == len_trim(str,pI64)) exit
+ if (str(c:c+1_pI64) == CR//LF) n = n + 1_pI64
end do
CRLF2LF = CRLF2LF(:c-n)
@@ -680,7 +680,7 @@ subroutine panel(paneltype,ID,msg,ext_msg,label1,ID1,label2,ID2)
integer, intent(in) :: ID
integer, optional, intent(in) :: ID1,ID2
- character(len=pStringLen) :: formatString
+ character(len=pSTRLEN) :: formatString
integer, parameter :: panelwidth = 69
character(len=*), parameter :: DIVIDER = repeat('─',panelwidth)
@@ -733,37 +733,37 @@ subroutine selfTest()
character(len=:), allocatable :: str,out
- if (dNeq(1.0_pReal, IO_stringAsFloat('1.0'))) error stop 'IO_stringAsFloat'
- if (dNeq(1.0_pReal, IO_stringAsFloat('1e0'))) error stop 'IO_stringAsFloat'
- if (dNeq(0.1_pReal, IO_stringAsFloat('1e-1'))) error stop 'IO_stringAsFloat'
- if (dNeq(0.1_pReal, IO_stringAsFloat('1.0e-1'))) error stop 'IO_stringAsFloat'
- if (dNeq(0.1_pReal, IO_stringAsFloat('1.00e-1'))) error stop 'IO_stringAsFloat'
- if (dNeq(10._pReal, IO_stringAsFloat(' 1.0e+1 '))) error stop 'IO_stringAsFloat'
+ if (dNeq(1.0_pREAL, IO_strAsReal('1.0'))) error stop 'IO_strAsReal'
+ if (dNeq(1.0_pREAL, IO_strAsReal('1e0'))) error stop 'IO_strAsReal'
+ if (dNeq(0.1_pREAL, IO_strAsReal('1e-1'))) error stop 'IO_strAsReal'
+ if (dNeq(0.1_pREAL, IO_strAsReal('1.0e-1'))) error stop 'IO_strAsReal'
+ if (dNeq(0.1_pREAL, IO_strAsReal('1.00e-1'))) error stop 'IO_strAsReal'
+ if (dNeq(10._pREAL, IO_strAsReal(' 1.0e+1 '))) error stop 'IO_strAsReal'
- if (3112019 /= IO_stringAsInt( '3112019')) error stop 'IO_stringAsInt'
- if (3112019 /= IO_stringAsInt(' 3112019')) error stop 'IO_stringAsInt'
- if (-3112019 /= IO_stringAsInt('-3112019')) error stop 'IO_stringAsInt'
- if (3112019 /= IO_stringAsInt('+3112019 ')) error stop 'IO_stringAsInt'
- if (3112019 /= IO_stringAsInt('03112019 ')) error stop 'IO_stringAsInt'
- if (3112019 /= IO_stringAsInt('+03112019')) error stop 'IO_stringAsInt'
+ if (3112019 /= IO_strAsInt( '3112019')) error stop 'IO_strAsInt'
+ if (3112019 /= IO_strAsInt(' 3112019')) error stop 'IO_strAsInt'
+ if (-3112019 /= IO_strAsInt('-3112019')) error stop 'IO_strAsInt'
+ if (3112019 /= IO_strAsInt('+3112019 ')) error stop 'IO_strAsInt'
+ if (3112019 /= IO_strAsInt('03112019 ')) error stop 'IO_strAsInt'
+ if (3112019 /= IO_strAsInt('+03112019')) error stop 'IO_strAsInt'
- if (.not. IO_stringAsBool(' true')) error stop 'IO_stringAsBool'
- if (.not. IO_stringAsBool(' True ')) error stop 'IO_stringAsBool'
- if ( IO_stringAsBool(' false')) error stop 'IO_stringAsBool'
- if ( IO_stringAsBool('False')) error stop 'IO_stringAsBool'
+ if (.not. IO_strAsBool(' true')) error stop 'IO_strAsBool'
+ if (.not. IO_strAsBool(' True ')) error stop 'IO_strAsBool'
+ if ( IO_strAsBool(' false')) error stop 'IO_strAsBool'
+ if ( IO_strAsBool('False')) error stop 'IO_strAsBool'
- if ('1234' /= IO_intAsString(1234)) error stop 'IO_intAsString'
- if ('-12' /= IO_intAsString(-0012)) error stop 'IO_intAsString'
+ if ('1234' /= IO_intAsStr(1234)) error stop 'IO_intAsStr'
+ if ('-12' /= IO_intAsStr(-0012)) error stop 'IO_intAsStr'
- if (any([1,1,1] /= IO_stringPos('a'))) error stop 'IO_stringPos'
- if (any([2,2,3,5,5] /= IO_stringPos(' aa b'))) error stop 'IO_stringPos'
+ if (any([1,1,1] /= IO_strPos('a'))) error stop 'IO_strPos'
+ if (any([2,2,3,5,5] /= IO_strPos(' aa b'))) error stop 'IO_strPos'
str = ' 1.0 xxx'
- chunkPos = IO_stringPos(str)
- if (dNeq(1.0_pReal,IO_floatValue(str,chunkPos,1))) error stop 'IO_floatValue'
+ chunkPos = IO_strPos(str)
+ if (dNeq(1.0_pREAL,IO_realValue(str,chunkPos,1))) error stop 'IO_realValue'
str = 'M 3112019 F'
- chunkPos = IO_stringPos(str)
+ chunkPos = IO_strPos(str)
if (3112019 /= IO_intValue(str,chunkPos,2)) error stop 'IO_intValue'
if (CRLF2LF('') /= '') error stop 'CRLF2LF/0'
diff --git a/src/LAPACK_interface.f90 b/src/LAPACK_interface.f90
index cc451b59c..deb9d92e6 100644
--- a/src/LAPACK_interface.f90
+++ b/src/LAPACK_interface.f90
@@ -12,11 +12,11 @@ module LAPACK_interface
character, intent(in) :: jobvl,jobvr
integer, intent(in) :: n,lda,ldvl,ldvr,lwork
- real(pReal), intent(inout), dimension(lda,n) :: a
- real(pReal), intent(out), dimension(n) :: wr,wi
- real(pReal), intent(out), dimension(ldvl,n) :: vl
- real(pReal), intent(out), dimension(ldvr,n) :: vr
- real(pReal), intent(out), dimension(max(1,lwork)) :: work
+ real(pREAL), intent(inout), dimension(lda,n) :: a
+ real(pREAL), intent(out), dimension(n) :: wr,wi
+ real(pREAL), intent(out), dimension(ldvl,n) :: vl
+ real(pREAL), intent(out), dimension(ldvr,n) :: vr
+ real(pREAL), intent(out), dimension(max(1,lwork)) :: work
integer, intent(out) :: info
end subroutine dgeev
@@ -25,9 +25,9 @@ module LAPACK_interface
implicit none(type,external)
integer, intent(in) :: n,nrhs,lda,ldb
- real(pReal), intent(inout), dimension(lda,n) :: a
+ real(pREAL), intent(inout), dimension(lda,n) :: a
integer, intent(out), dimension(n) :: ipiv
- real(pReal), intent(inout), dimension(ldb,nrhs) :: b
+ real(pREAL), intent(inout), dimension(ldb,nrhs) :: b
integer, intent(out) :: info
end subroutine dgesv
@@ -36,7 +36,7 @@ module LAPACK_interface
implicit none(type,external)
integer, intent(in) :: m,n,lda
- real(pReal), intent(inout), dimension(lda,n) :: a
+ real(pREAL), intent(inout), dimension(lda,n) :: a
integer, intent(out), dimension(min(m,n)) :: ipiv
integer, intent(out) :: info
end subroutine dgetrf
@@ -46,9 +46,9 @@ module LAPACK_interface
implicit none(type,external)
integer, intent(in) :: n,lda,lwork
- real(pReal), intent(inout), dimension(lda,n) :: a
+ real(pREAL), intent(inout), dimension(lda,n) :: a
integer, intent(in), dimension(n) :: ipiv
- real(pReal), intent(out), dimension(max(1,lwork)) :: work
+ real(pREAL), intent(out), dimension(max(1,lwork)) :: work
integer, intent(out) :: info
end subroutine dgetri
@@ -58,9 +58,9 @@ module LAPACK_interface
character, intent(in) :: jobz,uplo
integer, intent(in) :: n,lda,lwork
- real(pReal), intent(inout), dimension(lda,n) :: a
- real(pReal), intent(out), dimension(n) :: w
- real(pReal), intent(out), dimension(max(1,lwork)) :: work
+ real(pREAL), intent(inout), dimension(lda,n) :: a
+ real(pREAL), intent(out), dimension(n) :: w
+ real(pREAL), intent(out), dimension(max(1,lwork)) :: work
integer, intent(out) :: info
end subroutine dsyev
diff --git a/src/Marc/DAMASK_Marc.f90 b/src/Marc/DAMASK_Marc.f90
index 92b89c334..032c77394 100644
--- a/src/Marc/DAMASK_Marc.f90
+++ b/src/Marc/DAMASK_Marc.f90
@@ -98,7 +98,7 @@ end function getSolverJobName
!--------------------------------------------------------------------------------------------------
logical function solverIsSymmetric()
- character(len=pStringLen) :: line
+ character(len=pSTRLEN) :: line
integer :: myStat,fileUnit,s,e
open(newunit=fileUnit, file=getSolverJobName()//INPUTFILEEXTENSION, &
@@ -233,32 +233,32 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
matus, & !< (1) user material identification number, (2) internal material identification number
kcus, & !< (1) layer number, (2) internal layer number
lclass !< (1) element class, (2) 0: displacement, 1: low order Herrmann, 2: high order Herrmann
- real(pReal), dimension(*), intent(in) :: & ! has dimension(1) according to MSC.Marc 2012 Manual D, but according to example hypela2.f dimension(*)
+ real(pREAL), dimension(*), intent(in) :: & ! has dimension(1) according to MSC.Marc 2012 Manual D, but according to example hypela2.f dimension(*)
e, & !< total elastic strain
de, & !< increment of strain
dt !< increment of state variables
- real(pReal), dimension(itel), intent(in) :: & ! according to MSC.Marc 2012 Manual D
+ real(pREAL), dimension(itel), intent(in) :: & ! according to MSC.Marc 2012 Manual D
strechn, & !< square of principal stretch ratios, lambda(i) at t=n
strechn1 !< square of principal stretch ratios, lambda(i) at t=n+1
- real(pReal), dimension(3,3), intent(in) :: & ! has dimension(itel,*) according to MSC.Marc 2012 Manual D, but we alway assume dimension(3,3)
+ real(pREAL), dimension(3,3), intent(in) :: & ! has dimension(itel,*) according to MSC.Marc 2012 Manual D, but we alway assume dimension(3,3)
ffn, & !< deformation gradient at t=n
ffn1 !< deformation gradient at t=n+1
- real(pReal), dimension(itel,*), intent(in) :: & ! according to MSC.Marc 2012 Manual D
+ real(pREAL), dimension(itel,*), intent(in) :: & ! according to MSC.Marc 2012 Manual D
frotn, & !< rotation tensor at t=n
eigvn, & !< i principal direction components for j eigenvalues at t=n
frotn1, & !< rotation tensor at t=n+1
eigvn1 !< i principal direction components for j eigenvalues at t=n+1
- real(pReal), dimension(ndeg,*), intent(in) :: & ! according to MSC.Marc 2012 Manual D
+ real(pREAL), dimension(ndeg,*), intent(in) :: & ! according to MSC.Marc 2012 Manual D
disp, & !< incremental displacements
dispt !< displacements at t=n (at assembly, lovl=4) and displacements at t=n+1 (at stress recovery, lovl=6)
- real(pReal), dimension(ncrd,*), intent(in) :: & ! according to MSC.Marc 2012 Manual D
+ real(pREAL), dimension(ncrd,*), intent(in) :: & ! according to MSC.Marc 2012 Manual D
coord !< coordinates
- real(pReal), dimension(*), intent(inout) :: & ! according to MSC.Marc 2012 Manual D
+ real(pREAL), dimension(*), intent(inout) :: & ! according to MSC.Marc 2012 Manual D
t !< state variables (comes in at t=n, must be updated to have state variables at t=n+1)
- real(pReal), dimension(ndi+nshear), intent(out) :: & ! has dimension(*) according to MSC.Marc 2012 Manual D, but we need to loop over it
+ real(pREAL), dimension(ndi+nshear), intent(out) :: & ! has dimension(*) according to MSC.Marc 2012 Manual D, but we need to loop over it
s, & !< stress - should be updated by user
g !< change in stress due to temperature effects
- real(pReal), dimension(ngens,ngens), intent(out) :: & ! according to MSC.Marc 2012 Manual D, but according to example hypela2.f dimension(ngens,*)
+ real(pREAL), dimension(ngens,ngens), intent(out) :: & ! according to MSC.Marc 2012 Manual D, but according to example hypela2.f dimension(ngens,*)
d !< stress-strain law to be formed
!--------------------------------------------------------------------------------------------------
@@ -269,17 +269,17 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
#include QUOTE(PASTE(include/creeps,MARC4DAMASK)) ! creeps is needed for timinc (time increment)
logical :: cutBack
- real(pReal), dimension(6) :: stress
- real(pReal), dimension(6,6) :: ddsdde
+ real(pREAL), dimension(6) :: stress
+ real(pREAL), dimension(6,6) :: ddsdde
integer :: computationMode, i, node, CPnodeID
integer(pI32) :: defaultNumThreadsInt !< default value set by Marc
integer, save :: &
theInc = -1, & !< needs description
lastLovl = 0 !< lovl in previous call to marc hypela2
- real(pReal), save :: &
- theTime = 0.0_pReal, & !< needs description
- theDelta = 0.0_pReal
+ real(pREAL), save :: &
+ theTime = 0.0_pREAL, & !< needs description
+ theDelta = 0.0_pREAL
logical, save :: &
lastIncConverged = .false., & !< needs description
outdatedByNewInc = .false., & !< needs description
@@ -351,8 +351,8 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
d = ddsdde(1:ngens,1:ngens)
s = stress(1:ndi+nshear)
- g = 0.0_pReal
- if (symmetricSolver) d = 0.5_pReal*(d+transpose(d))
+ g = 0.0_pREAL
+ if (symmetricSolver) d = 0.5_pREAL*(d+transpose(d))
call omp_set_num_threads(defaultNumThreadsInt) ! reset number of threads to stored default value
@@ -368,18 +368,18 @@ subroutine flux(f,ts,n,time)
use discretization_Marc
implicit none(type,external)
- real(pReal), dimension(6), intent(in) :: &
+ real(pREAL), dimension(6), intent(in) :: &
ts
integer(pI64), dimension(10), intent(in) :: &
n
- real(pReal), intent(in) :: &
+ real(pREAL), intent(in) :: &
time
- real(pReal), dimension(2), intent(out) :: &
+ real(pREAL), dimension(2), intent(out) :: &
f
f(1) = homogenization_f_T(discretization_Marc_FEM2DAMASK_cell(int(n(3)),int(n(1))))
- f(2) = 0.0_pReal
+ f(2) = 0.0_pREAL
end subroutine flux
@@ -402,7 +402,7 @@ subroutine uedinc(inc,incsub)
integer :: n, nqncomp, nqdatatype
integer, save :: inc_written
- real(pReal), allocatable, dimension(:,:) :: d_n
+ real(pREAL), allocatable, dimension(:,:) :: d_n
#include QUOTE(PASTE(include/creeps,MARC4DAMASK)) ! creeps is needed for timinc (time increment)
@@ -411,7 +411,7 @@ subroutine uedinc(inc,incsub)
do n = lbound(discretization_Marc_FEM2DAMASK_node,1), ubound(discretization_Marc_FEM2DAMASK_node,1)
if (discretization_Marc_FEM2DAMASK_node(n) /= -1) then
call nodvar(1,n,d_n(1:3,discretization_Marc_FEM2DAMASK_node(n)),nqncomp,nqdatatype)
- if (nqncomp == 2) d_n(3,discretization_Marc_FEM2DAMASK_node(n)) = 0.0_pReal
+ if (nqncomp == 2) d_n(3,discretization_Marc_FEM2DAMASK_node(n)) = 0.0_pREAL
end if
end do
diff --git a/src/Marc/discretization_Marc.f90 b/src/Marc/discretization_Marc.f90
index 46e9eba45..63fe3f194 100644
--- a/src/Marc/discretization_Marc.f90
+++ b/src/Marc/discretization_Marc.f90
@@ -20,7 +20,7 @@ module discretization_Marc
implicit none(type,external)
private
- real(pReal), public, protected :: &
+ real(pREAL), public, protected :: &
mesh_unitlength !< physical length of one unit in mesh MD: needs systematic_name
integer, dimension(:), allocatable, public, protected :: &
@@ -51,7 +51,7 @@ contains
!--------------------------------------------------------------------------------------------------
subroutine discretization_Marc_init
- real(pReal), dimension(:,:), allocatable :: &
+ real(pREAL), dimension(:,:), allocatable :: &
node0_elem, & !< node x,y,z coordinates (initially!)
node0_cell
type(tElement) :: elem
@@ -61,11 +61,11 @@ subroutine discretization_Marc_init
integer:: &
Nelems !< total number of elements in the mesh
- real(pReal), dimension(:,:), allocatable :: &
+ real(pREAL), dimension(:,:), allocatable :: &
IP_reshaped
integer, dimension(:,:), allocatable :: &
connectivity_elem
- real(pReal), dimension(:,:,:,:), allocatable :: &
+ real(pREAL), dimension(:,:,:,:), allocatable :: &
unscaledNormals
type(tDict), pointer :: &
@@ -75,8 +75,8 @@ subroutine discretization_Marc_init
print'(/,a)', ' <<<+- discretization_Marc init -+>>>'; flush(6)
num_commercialFEM => config_numerics%get_dict('commercialFEM',defaultVal = emptyDict)
- mesh_unitlength = num_commercialFEM%get_asFloat('unitlength',defaultVal=1.0_pReal) ! set physical extent of a length unit in mesh
- if (mesh_unitlength <= 0.0_pReal) call IO_error(301,'unitlength')
+ mesh_unitlength = num_commercialFEM%get_asReal('unitlength',defaultVal=1.0_pREAL) ! set physical extent of a length unit in mesh
+ if (mesh_unitlength <= 0.0_pREAL) call IO_error(301,'unitlength')
call inputRead(elem,node0_elem,connectivity_elem,materialAt)
nElems = size(connectivity_elem,2)
@@ -113,9 +113,9 @@ end subroutine discretization_Marc_init
!--------------------------------------------------------------------------------------------------
subroutine discretization_Marc_updateNodeAndIpCoords(d_n)
- real(pReal), dimension(:,:), intent(in) :: d_n
+ real(pREAL), dimension(:,:), intent(in) :: d_n
- real(pReal), dimension(:,:), allocatable :: node_cell
+ real(pREAL), dimension(:,:), allocatable :: node_cell
node_cell = buildCellNodes(discretization_NodeCoords0(1:3,1:maxval(discretization_Marc_FEM2DAMASK_node)) + d_n)
@@ -134,7 +134,7 @@ function discretization_Marc_FEM2DAMASK_cell(IP_FEM,elem_FEM) result(cell)
integer, intent(in) :: IP_FEM, elem_FEM
integer :: cell
- real(pReal), dimension(:,:), allocatable :: node_cell
+ real(pREAL), dimension(:,:), allocatable :: node_cell
cell = (discretization_Marc_FEM2DAMASK_elem(elem_FEM)-1)*discretization_nIPs + IP_FEM
@@ -155,7 +155,7 @@ subroutine writeGeometry(elem, &
integer, dimension(:,:), intent(in) :: &
connectivity_elem, &
connectivity_cell_reshaped
- real(pReal), dimension(:,:), intent(in) :: &
+ real(pREAL), dimension(:,:), intent(in) :: &
coordinates_nodes, &
coordinates_points
@@ -187,7 +187,7 @@ end subroutine writeGeometry
subroutine inputRead(elem,node0_elem,connectivity_elem,materialAt)
type(tElement), intent(out) :: elem
- real(pReal), dimension(:,:), allocatable, intent(out) :: &
+ real(pREAL), dimension(:,:), allocatable, intent(out) :: &
node0_elem !< node x,y,z coordinates (initially!)
integer, dimension(:,:), allocatable, intent(out) :: &
connectivity_elem
@@ -202,7 +202,7 @@ subroutine inputRead(elem,node0_elem,connectivity_elem,materialAt)
nElems
integer, dimension(:), allocatable :: &
matNumber !< material numbers for hypoelastic material
- character(len=pStringLen), dimension(:), allocatable :: &
+ character(len=pSTRLEN), dimension(:), allocatable :: &
inputFile, & !< file content, separated per lines
nameElemSet
integer, dimension(:,:), allocatable :: &
@@ -263,9 +263,9 @@ subroutine inputRead_fileFormat(fileFormat,fileContent)
integer :: l
do l = 1, size(fileContent)
- chunkPos = IO_stringPos(fileContent(l))
+ chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 2) cycle
- if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'version') then
+ if (IO_lc(IO_strValue(fileContent(l),chunkPos,1)) == 'version') then
fileFormat = IO_intValue(fileContent(l),chunkPos,2)
exit
end if
@@ -289,9 +289,9 @@ subroutine inputRead_tableStyles(initialcond,hypoelastic,fileContent)
hypoelastic = 0
do l = 1, size(fileContent)
- chunkPos = IO_stringPos(fileContent(l))
+ chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 6) cycle
- if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'table') then
+ if (IO_lc(IO_strValue(fileContent(l),chunkPos,1)) == 'table') then
initialcond = IO_intValue(fileContent(l),chunkPos,4)
hypoelastic = IO_intValue(fileContent(l),chunkPos,5)
exit
@@ -316,11 +316,11 @@ subroutine inputRead_matNumber(matNumber, &
do l = 1, size(fileContent)
- chunkPos = IO_stringPos(fileContent(l))
+ chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 1) cycle
- if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'hypoelastic') then
+ if (IO_lc(IO_strValue(fileContent(l),chunkPos,1)) == 'hypoelastic') then
if (len_trim(fileContent(l+1))/=0) then
- chunkPos = IO_stringPos(fileContent(l+1))
+ chunkPos = IO_strPos(fileContent(l+1))
data_blocks = IO_intValue(fileContent(l+1),chunkPos,1)
else
data_blocks = 1
@@ -328,7 +328,7 @@ subroutine inputRead_matNumber(matNumber, &
allocate(matNumber(data_blocks), source = 0)
do i = 0, data_blocks - 1
j = i*(2+tableStyle) + 1
- chunkPos = IO_stringPos(fileContent(l+1+j))
+ chunkPos = IO_strPos(fileContent(l+1+j))
matNumber(i+1) = IO_intValue(fileContent(l+1+j),chunkPos,1)
end do
exit
@@ -354,12 +354,12 @@ subroutine inputRead_NnodesAndElements(nNodes,nElems,&
nElems = 0
do l = 1, size(fileContent)
- chunkPos = IO_stringPos(fileContent(l))
+ chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 1) cycle
- if (IO_lc(IO_StringValue(fileContent(l),chunkPos,1)) == 'sizing') then
+ if (IO_lc(IO_StrValue(fileContent(l),chunkPos,1)) == 'sizing') then
nElems = IO_IntValue (fileContent(l),chunkPos,3)
- elseif (IO_lc(IO_StringValue(fileContent(l),chunkPos,1)) == 'coordinates') then
- chunkPos = IO_stringPos(fileContent(l+1))
+ elseif (IO_lc(IO_StrValue(fileContent(l),chunkPos,1)) == 'coordinates') then
+ chunkPos = IO_strPos(fileContent(l+1))
nNodes = IO_IntValue (fileContent(l+1),chunkPos,2)
end if
end do
@@ -384,13 +384,13 @@ subroutine inputRead_NelemSets(nElemSets,maxNelemInSet,&
maxNelemInSet = 0
do l = 1, size(fileContent)
- chunkPos = IO_stringPos(fileContent(l))
+ chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 2) cycle
- if (IO_lc(IO_StringValue(fileContent(l),chunkPos,1)) == 'define' .and. &
- IO_lc(IO_StringValue(fileContent(l),chunkPos,2)) == 'element') then
+ if (IO_lc(IO_StrValue(fileContent(l),chunkPos,1)) == 'define' .and. &
+ IO_lc(IO_StrValue(fileContent(l),chunkPos,2)) == 'element') then
nElemSets = nElemSets + 1
- chunkPos = IO_stringPos(fileContent(l+1))
+ chunkPos = IO_strPos(fileContent(l+1))
if (containsRange(fileContent(l+1),chunkPos)) then
elemInCurrentSet = 1 + abs( IO_intValue(fileContent(l+1),chunkPos,3) &
-IO_intValue(fileContent(l+1),chunkPos,1))
@@ -399,9 +399,9 @@ subroutine inputRead_NelemSets(nElemSets,maxNelemInSet,&
i = 0
do while (.true.)
i = i + 1
- chunkPos = IO_stringPos(fileContent(l+i))
+ chunkPos = IO_strPos(fileContent(l+i))
elemInCurrentSet = elemInCurrentSet + chunkPos(1) - 1 ! add line's count when assuming 'c'
- if (IO_lc(IO_stringValue(fileContent(l+i),chunkPos,chunkPos(1))) /= 'c') then ! line finished, read last value
+ if (IO_lc(IO_strValue(fileContent(l+i),chunkPos,chunkPos(1))) /= 'c') then ! line finished, read last value
elemInCurrentSet = elemInCurrentSet + 1 ! data ended
exit
end if
@@ -420,7 +420,7 @@ end subroutine inputRead_NelemSets
subroutine inputRead_mapElemSets(nameElemSet,mapElemSet,&
fileContent)
- character(len=pStringLen), dimension(:), allocatable, intent(out) :: nameElemSet
+ character(len=pSTRLEN), dimension(:), allocatable, intent(out) :: nameElemSet
integer, dimension(:,:), allocatable, intent(out) :: mapElemSet
character(len=*), dimension(:), intent(in) :: fileContent !< file content, separated per lines
@@ -434,12 +434,12 @@ subroutine inputRead_mapElemSets(nameElemSet,mapElemSet,&
elemSet = 0
do l = 1, size(fileContent)
- chunkPos = IO_stringPos(fileContent(l))
+ chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 2) cycle
- if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'define' .and. &
- IO_lc(IO_stringValue(fileContent(l),chunkPos,2)) == 'element') then
+ if (IO_lc(IO_strValue(fileContent(l),chunkPos,1)) == 'define' .and. &
+ IO_lc(IO_strValue(fileContent(l),chunkPos,2)) == 'element') then
elemSet = elemSet+1
- nameElemSet(elemSet) = trim(IO_stringValue(fileContent(l),chunkPos,4))
+ nameElemSet(elemSet) = trim(IO_strValue(fileContent(l),chunkPos,4))
mapElemSet(:,elemSet) = continuousIntValues(fileContent(l+1:),size(mapElemSet,1)-1,nameElemSet,mapElemSet,size(nameElemSet))
end if
end do
@@ -465,17 +465,17 @@ subroutine inputRead_mapElems(FEM2DAMASK, &
do l = 1, size(fileContent)
- chunkPos = IO_stringPos(fileContent(l))
+ chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 1) cycle
- if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'connectivity') then
+ if (IO_lc(IO_strValue(fileContent(l),chunkPos,1)) == 'connectivity') then
j = 0
do i = 1,nElems
- chunkPos = IO_stringPos(fileContent(l+1+i+j))
+ chunkPos = IO_strPos(fileContent(l+1+i+j))
map_unsorted(:,i) = [IO_intValue(fileContent(l+1+i+j),chunkPos,1),i]
nNodesAlreadyRead = chunkPos(1) - 2
do while(nNodesAlreadyRead < nNodesPerElem) ! read on if not all nodes in one line
j = j + 1
- chunkPos = IO_stringPos(fileContent(l+1+i+j))
+ chunkPos = IO_strPos(fileContent(l+1+i+j))
nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1)
end do
end do
@@ -509,9 +509,9 @@ subroutine inputRead_mapNodes(FEM2DAMASK, &
do l = 1, size(fileContent)
- chunkPos = IO_stringPos(fileContent(l))
+ chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 1) cycle
- if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'coordinates') then
+ if (IO_lc(IO_strValue(fileContent(l),chunkPos,1)) == 'coordinates') then
chunkPos = [1,1,10]
do i = 1,nNodes
map_unsorted(:,i) = [IO_intValue(fileContent(l+1+i),chunkPos,1),i]
@@ -535,7 +535,7 @@ end subroutine inputRead_mapNodes
subroutine inputRead_elemNodes(nodes, &
nNode,fileContent)
- real(pReal), allocatable, dimension(:,:), intent(out) :: nodes
+ real(pREAL), allocatable, dimension(:,:), intent(out) :: nodes
integer, intent(in) :: nNode
character(len=*), dimension(:), intent(in) :: fileContent !< file content, separated per lines
@@ -546,13 +546,13 @@ subroutine inputRead_elemNodes(nodes, &
allocate(nodes(3,nNode))
do l = 1, size(fileContent)
- chunkPos = IO_stringPos(fileContent(l))
+ chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 1) cycle
- if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'coordinates') then
+ if (IO_lc(IO_strValue(fileContent(l),chunkPos,1)) == 'coordinates') then
chunkPos = [4,1,10,11,30,31,50,51,70]
do i=1,nNode
m = discretization_Marc_FEM2DAMASK_node(IO_intValue(fileContent(l+1+i),chunkPos,1))
- nodes(1:3,m) = [(mesh_unitlength * IO_floatValue(fileContent(l+1+i),chunkPos,j+1),j=1,3)]
+ nodes(1:3,m) = [(mesh_unitlength * IO_realValue(fileContent(l+1+i),chunkPos,j+1),j=1,3)]
end do
exit
end if
@@ -577,23 +577,23 @@ subroutine inputRead_elemType(elem, &
t = -1
do l = 1, size(fileContent)
- chunkPos = IO_stringPos(fileContent(l))
+ chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 1) cycle
- if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'connectivity') then
+ if (IO_lc(IO_strValue(fileContent(l),chunkPos,1)) == 'connectivity') then
j = 0
do i=1,nElem ! read all elements
- chunkPos = IO_stringPos(fileContent(l+1+i+j))
+ chunkPos = IO_strPos(fileContent(l+1+i+j))
if (t == -1) then
- t = mapElemtype(IO_stringValue(fileContent(l+1+i+j),chunkPos,2))
+ t = mapElemtype(IO_strValue(fileContent(l+1+i+j),chunkPos,2))
call elem%init(t)
else
- t_ = mapElemtype(IO_stringValue(fileContent(l+1+i+j),chunkPos,2))
- if (t /= t_) call IO_error(191,IO_stringValue(fileContent(l+1+i+j),chunkPos,2),label1='type',ID1=t)
+ t_ = mapElemtype(IO_strValue(fileContent(l+1+i+j),chunkPos,2))
+ if (t /= t_) call IO_error(191,IO_strValue(fileContent(l+1+i+j),chunkPos,2),label1='type',ID1=t)
end if
remainingChunks = elem%nNodes - (chunkPos(1) - 2)
do while(remainingChunks > 0)
j = j + 1
- chunkPos = IO_stringPos(fileContent(l+1+i+j))
+ chunkPos = IO_strPos(fileContent(l+1+i+j))
remainingChunks = remainingChunks - chunkPos(1)
end do
end do
@@ -668,12 +668,12 @@ function inputRead_connectivityElem(nElem,nNodes,fileContent)
do l = 1, size(fileContent)
- chunkPos = IO_stringPos(fileContent(l))
+ chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 1) cycle
- if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'connectivity') then
+ if (IO_lc(IO_strValue(fileContent(l),chunkPos,1)) == 'connectivity') then
j = 0
do i = 1,nElem
- chunkPos = IO_stringPos(fileContent(l+1+i+j))
+ chunkPos = IO_strPos(fileContent(l+1+i+j))
e = discretization_Marc_FEM2DAMASK_elem(IO_intValue(fileContent(l+1+i+j),chunkPos,1))
if (e /= 0) then ! disregard non CP elems
do k = 1,chunkPos(1)-2
@@ -683,7 +683,7 @@ function inputRead_connectivityElem(nElem,nNodes,fileContent)
nNodesAlreadyRead = chunkPos(1) - 2
do while(nNodesAlreadyRead < nNodes) ! read on if not all nodes in one line
j = j + 1
- chunkPos = IO_stringPos(fileContent(l+1+i+j))
+ chunkPos = IO_strPos(fileContent(l+1+i+j))
do k = 1,chunkPos(1)
inputRead_connectivityElem(nNodesAlreadyRead+k,e) = &
discretization_Marc_FEM2DAMASK_node(IO_IntValue(fileContent(l+1+i+j),chunkPos,k))
@@ -725,18 +725,18 @@ subroutine inputRead_material(materialAt,&
allocate(materialAt(nElem))
do l = 1, size(fileContent)
- chunkPos = IO_stringPos(fileContent(l))
+ chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 2) cycle
- if (IO_lc(IO_stringValue(fileContent(l),chunkPos,1)) == 'initial' .and. &
- IO_lc(IO_stringValue(fileContent(l),chunkPos,2)) == 'state') then
+ if (IO_lc(IO_strValue(fileContent(l),chunkPos,1)) == 'initial' .and. &
+ IO_lc(IO_strValue(fileContent(l),chunkPos,2)) == 'state') then
k = merge(2,1,initialcondTableStyle == 2)
- chunkPos = IO_stringPos(fileContent(l+k))
+ chunkPos = IO_strPos(fileContent(l+k))
sv = IO_IntValue(fileContent(l+k),chunkPos,1) ! # of state variable
if (sv == 2) then ! state var 2 gives material ID
m = 1
- chunkPos = IO_stringPos(fileContent(l+k+m))
- do while (scan(IO_stringValue(fileContent(l+k+m),chunkPos,1),'+-',back=.true.)>1) ! is noEfloat value?
- ID = nint(IO_floatValue(fileContent(l+k+m),chunkPos,1))
+ chunkPos = IO_strPos(fileContent(l+k+m))
+ do while (scan(IO_strValue(fileContent(l+k+m),chunkPos,1),'+-',back=.true.)>1) ! is no Efloat value?
+ ID = nint(IO_realValue(fileContent(l+k+m),chunkPos,1))
if (initialcondTableStyle == 2) m = m + 2
contInts = continuousIntValues(fileContent(l+k+m+1:),nElem,nameElemSet,mapElemSet,size(nameElemSet)) ! get affected elements
do i = 1,contInts(1)
@@ -914,8 +914,8 @@ end subroutine buildCells
!--------------------------------------------------------------------------------------------------
pure function buildCellNodes(node_elem)
- real(pReal), dimension(:,:), intent(in) :: node_elem !< element nodes
- real(pReal), dimension(:,:), allocatable :: buildCellNodes !< cell node coordinates
+ real(pREAL), dimension(:,:), intent(in) :: node_elem !< element nodes
+ real(pREAL), dimension(:,:), allocatable :: buildCellNodes !< cell node coordinates
integer :: i, j, k, n
@@ -927,13 +927,13 @@ pure function buildCellNodes(node_elem)
do i = 1, size(cellNodeDefinition)
do j = 1, size(cellNodeDefinition(i)%parents,1)
n = n+1
- buildCellNodes(:,n) = 0.0_pReal
+ buildCellNodes(:,n) = 0.0_pREAL
do k = 1, size(cellNodeDefinition(i)%parents,2)
buildCellNodes(:,n) = buildCellNodes(:,n) &
+ buildCellNodes(:,cellNodeDefinition(i)%parents(j,k)) &
- * real(cellNodeDefinition(i)%weights(j,k),pReal)
+ * real(cellNodeDefinition(i)%weights(j,k),pREAL)
end do
- buildCellNodes(:,n) = buildCellNodes(:,n)/real(sum(cellNodeDefinition(i)%weights(j,:)),pReal)
+ buildCellNodes(:,n) = buildCellNodes(:,n)/real(sum(cellNodeDefinition(i)%weights(j,:)),pREAL)
end do
end do
@@ -945,8 +945,8 @@ end function buildCellNodes
!--------------------------------------------------------------------------------------------------
pure function buildIPcoordinates(node_cell)
- real(pReal), dimension(:,:), intent(in) :: node_cell !< cell node coordinates
- real(pReal), dimension(:,:), allocatable :: buildIPcoordinates !< cell-center/IP coordinates
+ real(pREAL), dimension(:,:), intent(in) :: node_cell !< cell node coordinates
+ real(pREAL), dimension(:,:), allocatable :: buildIPcoordinates !< cell-center/IP coordinates
integer, dimension(:,:), allocatable :: connectivity_cell_reshaped
integer :: i, n, NcellNodesPerCell,Ncells
@@ -959,12 +959,12 @@ pure function buildIPcoordinates(node_cell)
allocate(buildIPcoordinates(3,Ncells))
do i = 1, size(connectivity_cell_reshaped,2)
- buildIPcoordinates(:,i) = 0.0_pReal
+ buildIPcoordinates(:,i) = 0.0_pREAL
do n = 1, size(connectivity_cell_reshaped,1)
buildIPcoordinates(:,i) = buildIPcoordinates(:,i) &
+ node_cell(:,connectivity_cell_reshaped(n,i))
end do
- buildIPcoordinates(:,i) = buildIPcoordinates(:,i)/real(size(connectivity_cell_reshaped,1),pReal)
+ buildIPcoordinates(:,i) = buildIPcoordinates(:,i)/real(size(connectivity_cell_reshaped,1),pREAL)
end do
end function buildIPcoordinates
@@ -978,10 +978,10 @@ end function buildIPcoordinates
pure function IPvolume(elem,node)
type(tElement), intent(in) :: elem
- real(pReal), dimension(:,:), intent(in) :: node
+ real(pREAL), dimension(:,:), intent(in) :: node
- real(pReal), dimension(elem%nIPs,size(connectivity_cell,3)) :: IPvolume
- real(pReal), dimension(3) :: x0,x1,x2,x3,x4,x5,x6,x7
+ real(pREAL), dimension(elem%nIPs,size(connectivity_cell,3)) :: IPvolume
+ real(pREAL), dimension(3) :: x0,x1,x2,x3,x4,x5,x6,x7
integer :: e,i
@@ -1022,7 +1022,7 @@ pure function IPvolume(elem,node)
IPvolume(i,e) = dot_product((x7-x1)+(x6-x0),math_cross((x7-x2), (x3-x0))) &
+ dot_product((x6-x0), math_cross((x7-x2)+(x5-x0),(x7-x4))) &
+ dot_product((x7-x1), math_cross((x5-x0), (x7-x4)+(x3-x0)))
- IPvolume(i,e) = IPvolume(i,e)/12.0_pReal
+ IPvolume(i,e) = IPvolume(i,e)/12.0_pREAL
end select
end do
end do
@@ -1037,11 +1037,11 @@ pure function IPareaNormal(elem,nElem,node)
type(tElement), intent(in) :: elem
integer, intent(in) :: nElem
- real(pReal), dimension(:,:), intent(in) :: node
+ real(pREAL), dimension(:,:), intent(in) :: node
- real(pReal), dimension(3,elem%nIPneighbors,elem%nIPs,nElem) :: ipAreaNormal
+ real(pREAL), dimension(3,elem%nIPneighbors,elem%nIPs,nElem) :: ipAreaNormal
- real(pReal), dimension (3,size(elem%cellFace,1)) :: nodePos
+ real(pREAL), dimension (3,size(elem%cellFace,1)) :: nodePos
integer :: e,i,f,n,m
m = size(elem%cellFace,1)
@@ -1055,7 +1055,7 @@ pure function IPareaNormal(elem,nElem,node)
case (1,2) ! 2D 3 or 4 node
IPareaNormal(1,f,i,e) = nodePos(2,2) - nodePos(2,1) ! x_normal = y_connectingVector
IPareaNormal(2,f,i,e) = -(nodePos(1,2) - nodePos(1,1)) ! y_normal = -x_connectingVector
- IPareaNormal(3,f,i,e) = 0.0_pReal
+ IPareaNormal(3,f,i,e) = 0.0_pREAL
case (3) ! 3D 4node
IPareaNormal(1:3,f,i,e) = math_cross(nodePos(1:3,2) - nodePos(1:3,1), &
nodePos(1:3,3) - nodePos(1:3,1))
@@ -1063,11 +1063,11 @@ pure function IPareaNormal(elem,nElem,node)
! Get the normal of the quadrilateral face as the average of four normals of triangular
! subfaces. Since the face consists only of two triangles, the sum has to be divided
! by two. This procedure tries to compensate for probable non-planar cell surfaces
- IPareaNormal(1:3,f,i,e) = 0.0_pReal
+ IPareaNormal(1:3,f,i,e) = 0.0_pREAL
do n = 1, m
IPareaNormal(1:3,f,i,e) = IPareaNormal(1:3,f,i,e) &
+ math_cross(nodePos(1:3,mod(n+0,m)+1) - nodePos(1:3,n), &
- nodePos(1:3,mod(n+1,m)+1) - nodePos(1:3,n)) * 0.5_pReal
+ nodePos(1:3,mod(n+1,m)+1) - nodePos(1:3,n)) * 0.5_pREAL
end do
end select
end do
@@ -1156,12 +1156,12 @@ function continuousIntValues(fileContent,maxN,lookupName,lookupMap,lookupMaxN)
rangeGeneration = .false.
do l = 1, size(fileContent)
- chunkPos = IO_stringPos(fileContent(l))
+ chunkPos = IO_strPos(fileContent(l))
if (chunkPos(1) < 1) then ! empty line
exit
- elseif (verify(IO_stringValue(fileContent(l),chunkPos,1),'0123456789') > 0) then ! a non-int, i.e. set name
+ elseif (verify(IO_strValue(fileContent(l),chunkPos,1),'0123456789') > 0) then ! a non-int, i.e. set name
do i = 1, lookupMaxN ! loop over known set names
- if (IO_stringValue(fileContent(l),chunkPos,1) == lookupName(i)) then ! found matching name
+ if (IO_strValue(fileContent(l),chunkPos,1) == lookupName(i)) then ! found matching name
continuousIntValues = lookupMap(:,i) ! return resp. entity list
exit
end if
@@ -1180,7 +1180,7 @@ function continuousIntValues(fileContent,maxN,lookupName,lookupMap,lookupMaxN)
continuousIntValues(1) = continuousIntValues(1) + 1
continuousIntValues(1+continuousIntValues(1)) = IO_intValue(fileContent(l),chunkPos,i)
end do
- if ( IO_lc(IO_stringValue(fileContent(l),chunkPos,chunkPos(1))) /= 'c' ) then ! line finished, read last value
+ if ( IO_lc(IO_strValue(fileContent(l),chunkPos,chunkPos(1))) /= 'c' ) then ! line finished, read last value
continuousIntValues(1) = continuousIntValues(1) + 1
continuousIntValues(1+continuousIntValues(1)) = IO_intValue(fileContent(l),chunkPos,chunkPos(1))
exit
@@ -1202,7 +1202,7 @@ logical function containsRange(str,chunkPos)
containsRange = .False.
if (chunkPos(1) == 3) then
- if (IO_lc(IO_stringValue(str,chunkPos,2)) == 'to') containsRange = .True.
+ if (IO_lc(IO_strValue(str,chunkPos,2)) == 'to') containsRange = .True.
end if
end function containsRange
diff --git a/src/Marc/materialpoint_Marc.f90 b/src/Marc/materialpoint_Marc.f90
index 01d28ec80..151b9c1d2 100644
--- a/src/Marc/materialpoint_Marc.f90
+++ b/src/Marc/materialpoint_Marc.f90
@@ -27,11 +27,11 @@ module materialpoint_Marc
implicit none(type,external)
private
- real(pReal), dimension (:,:,:), allocatable, private :: &
+ real(pREAL), dimension (:,:,:), allocatable, private :: &
materialpoint_cs !< Cauchy stress
- real(pReal), dimension (:,:,:,:), allocatable, private :: &
+ real(pREAL), dimension (:,:,:,:), allocatable, private :: &
materialpoint_dcsdE !< Cauchy stress tangent
- real(pReal), dimension (:,:,:,:), allocatable, private :: &
+ real(pREAL), dimension (:,:,:,:), allocatable, private :: &
materialpoint_dcsdE_knownGood !< known good tangent
integer, public :: &
@@ -95,9 +95,9 @@ subroutine materialpoint_init()
print'(/,1x,a)', '<<<+- materialpoint init -+>>>'; flush(IO_STDOUT)
- allocate(materialpoint_cs( 6,discretization_nIPs,discretization_Nelems), source= 0.0_pReal)
- allocate(materialpoint_dcsdE( 6,6,discretization_nIPs,discretization_Nelems), source= 0.0_pReal)
- allocate(materialpoint_dcsdE_knownGood(6,6,discretization_nIPs,discretization_Nelems), source= 0.0_pReal)
+ allocate(materialpoint_cs( 6,discretization_nIPs,discretization_Nelems), source= 0.0_pREAL)
+ allocate(materialpoint_dcsdE( 6,6,discretization_nIPs,discretization_Nelems), source= 0.0_pREAL)
+ allocate(materialpoint_dcsdE_knownGood(6,6,discretization_nIPs,discretization_Nelems), source= 0.0_pREAL)
end subroutine materialpoint_init
@@ -110,25 +110,25 @@ subroutine materialpoint_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip,
integer, intent(in) :: elFE, & !< FE element number
ip !< integration point number
- real(pReal), intent(in) :: dt !< time increment
- real(pReal), dimension (3,3), intent(in) :: ffn, & !< deformation gradient for t=t0
+ real(pREAL), intent(in) :: dt !< time increment
+ real(pREAL), dimension (3,3), intent(in) :: ffn, & !< deformation gradient for t=t0
ffn1 !< deformation gradient for t=t1
integer, intent(in) :: mode !< computation mode 1: regular computation plus aging of results
- real(pReal), intent(in) :: temperature_inp !< temperature
- real(pReal), dimension(6), intent(out) :: cauchyStress !< stress as 6 vector
- real(pReal), dimension(6,6), intent(out) :: jacobian !< jacobian as 66 tensor (Consistent tangent dcs/dE)
+ real(pREAL), intent(in) :: temperature_inp !< temperature
+ real(pREAL), dimension(6), intent(out) :: cauchyStress !< stress as 6 vector
+ real(pREAL), dimension(6,6), intent(out) :: jacobian !< jacobian as 66 tensor (Consistent tangent dcs/dE)
- real(pReal) J_inverse, & ! inverse of Jacobian
+ real(pREAL) J_inverse, & ! inverse of Jacobian
rnd
- real(pReal), dimension (3,3) :: Kirchhoff ! Piola-Kirchhoff stress
- real(pReal), dimension (3,3,3,3) :: H_sym, &
+ real(pREAL), dimension (3,3) :: Kirchhoff ! Piola-Kirchhoff stress
+ real(pREAL), dimension (3,3,3,3) :: H_sym, &
H
integer elCP, & ! crystal plasticity element number
i, j, k, l, m, n, ph, homog, mySource,ce
- real(pReal), parameter :: ODD_STRESS = 1e15_pReal, & !< return value for stress if terminallyIll
- ODD_JACOBIAN = 1e50_pReal !< return value for jacobian if terminallyIll
+ real(pREAL), parameter :: ODD_STRESS = 1e15_pREAL, & !< return value for stress if terminallyIll
+ ODD_JACOBIAN = 1e50_pREAL !< return value for jacobian if terminallyIll
elCP = discretization_Marc_FEM2DAMASK_elem(elFE)
@@ -149,7 +149,7 @@ subroutine materialpoint_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip,
validCalculation: if (terminallyIll) then
call random_number(rnd)
- if (rnd < 0.5_pReal) rnd = rnd - 1.0_pReal
+ if (rnd < 0.5_pREAL) rnd = rnd - 1.0_pREAL
materialpoint_cs(1:6,ip,elCP) = ODD_STRESS * rnd
materialpoint_dcsde(1:6,1:6,ip,elCP) = ODD_JACOBIAN * math_eye(6)
@@ -161,7 +161,7 @@ subroutine materialpoint_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip,
terminalIllness: if (terminallyIll) then
call random_number(rnd)
- if (rnd < 0.5_pReal) rnd = rnd - 1.0_pReal
+ if (rnd < 0.5_pREAL) rnd = rnd - 1.0_pREAL
materialpoint_cs(1:6,ip,elCP) = ODD_STRESS * rnd
materialpoint_dcsde(1:6,1:6,ip,elCP) = ODD_JACOBIAN * math_eye(6)
@@ -169,22 +169,22 @@ subroutine materialpoint_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip,
! translate from P to sigma
Kirchhoff = matmul(homogenization_P(1:3,1:3,ce), transpose(homogenization_F(1:3,1:3,ce)))
- J_inverse = 1.0_pReal / math_det33(homogenization_F(1:3,1:3,ce))
+ J_inverse = 1.0_pREAL / math_det33(homogenization_F(1:3,1:3,ce))
materialpoint_cs(1:6,ip,elCP) = math_sym33to6(J_inverse * Kirchhoff,weighted=.false.)
! translate from dP/dF to dCS/dE
- H = 0.0_pReal
+ H = 0.0_pREAL
do i=1,3; do j=1,3; do k=1,3; do l=1,3; do m=1,3; do n=1,3
H(i,j,k,l) = H(i,j,k,l) &
+ homogenization_F(j,m,ce) * homogenization_F(l,n,ce) &
* homogenization_dPdF(i,m,k,n,ce) &
- math_delta(j,l) * homogenization_F(i,m,ce) * homogenization_P(k,m,ce) &
- + 0.5_pReal * ( Kirchhoff(j,l)*math_delta(i,k) + Kirchhoff(i,k)*math_delta(j,l) &
+ + 0.5_pREAL * ( Kirchhoff(j,l)*math_delta(i,k) + Kirchhoff(i,k)*math_delta(j,l) &
+ Kirchhoff(j,k)*math_delta(i,l) + Kirchhoff(i,l)*math_delta(j,k))
end do; end do; end do; end do; end do; end do
forall(i=1:3, j=1:3,k=1:3,l=1:3) &
- H_sym(i,j,k,l) = 0.25_pReal * (H(i,j,k,l) + H(j,i,k,l) + H(i,j,l,k) + H(j,i,l,k))
+ H_sym(i,j,k,l) = 0.25_pREAL * (H(i,j,k,l) + H(j,i,k,l) + H(i,j,l,k) + H(j,i,l,k))
materialpoint_dcsde(1:6,1:6,ip,elCP) = math_sym3333to66(J_inverse * H_sym,weighted=.false.)
@@ -193,7 +193,7 @@ subroutine materialpoint_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip,
end if
- if (all(abs(materialpoint_dcsdE(1:6,1:6,ip,elCP)) < 1e-10_pReal)) &
+ if (all(abs(materialpoint_dcsdE(1:6,1:6,ip,elCP)) < 1e-10_pREAL)) &
call IO_warning(601,label1='element (CP)',ID1=elCP,label2='IP',ID2=ip)
cauchyStress = materialpoint_cs (1:6, ip,elCP)
@@ -219,7 +219,7 @@ end subroutine materialpoint_forward
subroutine materialpoint_result(inc,time)
integer, intent(in) :: inc
- real(pReal), intent(in) :: time
+ real(pREAL), intent(in) :: time
call result_openJobFile()
call result_addIncrement(inc,time)
diff --git a/src/YAML_parse.f90 b/src/YAML_parse.f90
index 1581e8dc0..2e3702844 100644
--- a/src/YAML_parse.f90
+++ b/src/YAML_parse.f90
@@ -122,7 +122,7 @@ recursive function parse_flow(YAML_flow) result(node)
d = s + scan(flow_string(s+1_pI64:),':',kind=pI64)
e = d + find_end(flow_string(d+1_pI64:),'}')
key = trim(adjustl(flow_string(s+1_pI64:d-1_pI64)))
- if (quotedString(key)) key = key(2:len(key)-1)
+ if (quotedStr(key)) key = key(2:len(key)-1)
myVal => parse_flow(flow_string(d+1_pI64:e-1_pI64)) ! parse items (recursively)
select type (node)
@@ -147,7 +147,7 @@ recursive function parse_flow(YAML_flow) result(node)
allocate(tScalar::node)
select type (node)
class is (tScalar)
- if (quotedString(flow_string)) then
+ if (quotedStr(flow_string)) then
node = trim(adjustl(flow_string(2:len(flow_string)-1)))
else
node = trim(adjustl(flow_string))
@@ -191,21 +191,21 @@ end function find_end
!--------------------------------------------------------------------------------------------------
! @brief Check whether a string is enclosed with single or double quotes.
!--------------------------------------------------------------------------------------------------
-logical function quotedString(line)
+logical function quotedStr(line)
character(len=*), intent(in) :: line
- quotedString = .false.
+ quotedStr = .false.
if (len(line) == 0) return
if (scan(line(:1),IO_QUOTES) == 1) then
- quotedString = .true.
+ quotedStr = .true.
if (line(len(line):len(line)) /= line(:1)) call IO_error(710,ext_msg=line)
end if
-end function quotedString
+end function quotedStr
#ifdef FYAML
@@ -876,7 +876,7 @@ subroutine selfTest()
if (indentDepth('a') /= 0) error stop 'indentDepth'
if (indentDepth('x ') /= 0) error stop 'indentDepth'
- if (.not. quotedString("'a'")) error stop 'quotedString'
+ if (.not. quotedStr("'a'")) error stop 'quotedStr'
if ( isFlow(' a')) error stop 'isFLow'
if (.not. isFlow('{')) error stop 'isFlow'
@@ -1025,9 +1025,9 @@ subroutine selfTest()
dct = '{a: 1, b: 2}'
list => YAML_parse_str_asList(lst//IO_EOL)
- if (list%asFormattedString() /= lst) error stop 'str_asList'
+ if (list%asFormattedStr() /= lst) error stop 'str_asList'
dict => YAML_parse_str_asDict(dct//IO_EOL)
- if (dict%asFormattedString() /= dct) error stop 'str_asDict'
+ if (dict%asFormattedStr() /= dct) error stop 'str_asDict'
end block parse
diff --git a/src/YAML_types.f90 b/src/YAML_types.f90
index a6ac9766d..6a56d1dbc 100644
--- a/src/YAML_types.f90
+++ b/src/YAML_types.f90
@@ -18,8 +18,8 @@ module YAML_types
integer :: &
length = 0
contains
- procedure(asFormattedString), deferred :: &
- asFormattedString
+ procedure(asFormattedStr), deferred :: &
+ asFormattedStr
procedure :: &
asScalar => tNode_asScalar, &
asList => tNode_asList, &
@@ -31,11 +31,11 @@ module YAML_types
value
contains
procedure :: &
- asFormattedString => tScalar_asFormattedString, &
- asFloat => tScalar_asFloat, &
- asInt => tScalar_asInt, &
- asBool => tScalar_asBool, &
- asString => tScalar_asString
+ asFormattedStr => tScalar_asFormattedStr, &
+ asReal => tScalar_asReal, &
+ asInt => tScalar_asInt, &
+ asBool => tScalar_asBool, &
+ asStr => tScalar_asStr
end type tScalar
type, extends(tNode), public :: tList
@@ -44,76 +44,76 @@ module YAML_types
last => NULL()
contains
procedure :: &
- asFormattedString => tList_asFormattedString, &
+ asFormattedStr => tList_asFormattedStr, &
append => tList_append, &
- as1dFloat => tList_as1dFloat, &
- as2dFloat => tList_as2dFloat, &
+ as1dReal => tList_as1dReal, &
+ as2dReal => tList_as2dReal, &
as1dInt => tList_as1dInt, &
as1dBool => tList_as1dBool, &
- as1dString => tList_as1dString, &
+ as1dStr => tList_as1dStr, &
contains => tList_contains, &
tList_get, &
tList_get_scalar, &
tList_get_list, &
tList_get_dict, &
- tList_get_asFloat, &
- tList_get_as1dFloat, &
+ tList_get_asReal, &
+ tList_get_as1dReal, &
tList_get_asInt, &
tList_get_as1dInt, &
tList_get_asBool, &
tList_get_as1dBool, &
- tList_get_asString, &
- tList_get_as1dString
- generic :: get => tList_get
- generic :: get_scalar => tList_get_scalar
- generic :: get_list => tList_get_list
- generic :: get_dict => tList_get_dict
- generic :: get_asFloat => tList_get_asFloat
- generic :: get_as1dFloat => tList_get_as1dFloat
- generic :: get_asInt => tList_get_asInt
- generic :: get_as1dInt => tList_get_as1dInt
- generic :: get_asBool => tList_get_asBool
- generic :: get_as1dBool => tList_get_as1dBool
- generic :: get_asString => tList_get_asString
- generic :: get_as1dString => tList_get_as1dString
+ tList_get_asStr, &
+ tList_get_as1dStr
+ generic :: get => tList_get
+ generic :: get_scalar => tList_get_scalar
+ generic :: get_list => tList_get_list
+ generic :: get_dict => tList_get_dict
+ generic :: get_asReal => tList_get_asReal
+ generic :: get_as1dReal => tList_get_as1dReal
+ generic :: get_asInt => tList_get_asInt
+ generic :: get_as1dInt => tList_get_as1dInt
+ generic :: get_asBool => tList_get_asBool
+ generic :: get_as1dBool => tList_get_as1dBool
+ generic :: get_asStr => tList_get_asStr
+ generic :: get_as1dStr => tList_get_as1dStr
final :: tList_finalize
end type tList
type, extends(tList), public :: tDict
contains
procedure :: &
- asFormattedString => tDict_asFormattedString, &
- set => tDict_set, &
- index => tDict_index, &
- key => tDict_key, &
- keys => tDict_keys, &
- contains => tDict_contains, &
+ asFormattedStr => tDict_asFormattedStr, &
+ set => tDict_set, &
+ index => tDict_index, &
+ key => tDict_key, &
+ keys => tDict_keys, &
+ contains => tDict_contains, &
tDict_get, &
tDict_get_scalar, &
tDict_get_list, &
tDict_get_dict, &
- tDict_get_asFloat, &
- tDict_get_as1dFloat, &
- tDict_get_as2dFloat, &
+ tDict_get_asReal, &
+ tDict_get_as1dReal, &
+ tDict_get_as2dReal, &
tDict_get_asInt, &
tDict_get_as1dInt, &
tDict_get_asBool, &
tDict_get_as1dBool, &
- tDict_get_asString, &
- tDict_get_as1dString
- generic :: get => tDict_get
- generic :: get_scalar => tDict_get_scalar
- generic :: get_list => tDict_get_list
- generic :: get_dict => tDict_get_dict
- generic :: get_asFloat => tDict_get_asFloat
- generic :: get_as1dFloat => tDict_get_as1dFloat
- generic :: get_as2dFloat => tDict_get_as2dFloat
- generic :: get_asInt => tDict_get_asInt
- generic :: get_as1dInt => tDict_get_as1dInt
- generic :: get_asBool => tDict_get_asBool
- generic :: get_as1dBool => tDict_get_as1dBool
- generic :: get_asString => tDict_get_asString
- generic :: get_as1dString => tDict_get_as1dString
+ tDict_get_asStr, &
+ tDict_get_as1dStr
+ generic :: get => tDict_get
+ generic :: get_scalar => tDict_get_scalar
+ generic :: get_list => tDict_get_list
+ generic :: get_dict => tDict_get_dict
+ generic :: get_asReal => tDict_get_asReal
+ generic :: get_as1dReal => tDict_get_as1dReal
+ generic :: get_as2dReal => tDict_get_as2dReal
+ generic :: get_asInt => tDict_get_asInt
+ generic :: get_as1dInt => tDict_get_as1dInt
+ generic :: get_asBool => tDict_get_asBool
+ generic :: get_as1dBool => tDict_get_as1dBool
+ generic :: get_asStr => tDict_get_asStr
+ generic :: get_as1dStr => tDict_get_as1dStr
end type tDict
@@ -132,11 +132,11 @@ module YAML_types
abstract interface
- recursive function asFormattedString(self)
+ recursive function asFormattedStr(self)
import tNode
- character(len=:), allocatable :: asFormattedString
+ character(len=:), allocatable :: asFormattedStr
class(tNode), intent(in), target :: self
- end function asFormattedString
+ end function asFormattedStr
end interface
@@ -151,7 +151,7 @@ module YAML_types
public :: &
YAML_types_init, &
#ifdef __GFORTRAN__
- output_as1dString, & !ToDo: Hack for GNU. Remove later
+ output_as1dStr, & !ToDo: Hack for GNU. Remove later
#endif
assignment(=)
@@ -181,14 +181,14 @@ subroutine selfTest()
s_pointer => s%asScalar()
s = '1'
- if (s%asInt() /= 1) error stop 'tScalar_asInt'
- if (s_pointer%asInt() /= 1) error stop 'tScalar_asInt(pointer)'
- if (dNeq(s%asFloat(),1.0_pReal)) error stop 'tScalar_asFloat'
+ if (s%asInt() /= 1) error stop 'tScalar_asInt'
+ if (s_pointer%asInt() /= 1) error stop 'tScalar_asInt(pointer)'
+ if (dNeq(s%asReal(),1.0_pREAL)) error stop 'tScalar_asReal'
s = 'true'
- if (.not. s%asBool()) error stop 'tScalar_asBool'
- if (.not. s_pointer%asBool()) error stop 'tScalar_asBool(pointer)'
- if (s%asString() /= 'true') error stop 'tScalar_asString'
- if (s%asFormattedString() /= 'true') error stop 'tScalar_asFormattedString'
+ if (.not. s%asBool()) error stop 'tScalar_asBool'
+ if (.not. s_pointer%asBool()) error stop 'tScalar_asBool(pointer)'
+ if (s%asStr() /= 'true') error stop 'tScalar_asStr'
+ if (s%asFormattedStr() /= 'true') error stop 'tScalar_asFormattedStr'
end block scalar
@@ -204,23 +204,23 @@ subroutine selfTest()
s2 = '2'
allocate(l)
l_pointer => l%asList()
- if (l%contains('1')) error stop 'empty tList_contains'
- if (l_pointer%contains('1')) error stop 'empty tList_contains(pointer)'
+ if (l%contains('1')) error stop 'empty tList_contains'
+ if (l_pointer%contains('1')) error stop 'empty tList_contains(pointer)'
call l%append(s1)
call l%append(s2)
- if (l%length /= 2) error stop 'tList%len'
- if (dNeq(l%get_asFloat(1),1.0_pReal)) error stop 'tList_get_asFloat'
- if (l%get_asInt(1) /= 1) error stop 'tList_get_asInt'
- if (l%get_asString(2) /= '2') error stop 'tList_get_asString'
- if (any(l%as1dInt() /= [1,2])) error stop 'tList_as1dInt'
- if (any(dNeq(l%as1dFloat(),real([1.0,2.0],pReal)))) error stop 'tList_as1dFloat'
+ if (l%length /= 2) error stop 'tList%len'
+ if (dNeq(l%get_asReal(1),1.0_pREAL)) error stop 'tList_get_asReal'
+ if (l%get_asInt(1) /= 1) error stop 'tList_get_asInt'
+ if (l%get_asStr(2) /= '2') error stop 'tList_get_asStr'
+ if (any(l%as1dInt() /= [1,2])) error stop 'tList_as1dInt'
+ if (any(dNeq(l%as1dReal(),real([1.0,2.0],pREAL)))) error stop 'tList_as1dReal'
s1 = 'true'
s2 = 'false'
- if (any(l%as1dBool() .neqv. [.true.,.false.])) error stop 'tList_as1dBool'
- if (any(l%as1dString() /= ['true ','false'])) error stop 'tList_as1dString'
- if (l%asFormattedString() /= '[true, false]') error stop 'tList_asFormattedString'
+ if (any(l%as1dBool() .neqv. [.true.,.false.])) error stop 'tList_as1dBool'
+ if (any(l%as1dStr() /= ['true ','false'])) error stop 'tList_as1dStr'
+ if (l%asFormattedStr() /= '[true, false]') error stop 'tList_asFormattedStr'
if ( .not. l%contains('true') &
- .or. .not. l%contains('false')) error stop 'tList_contains'
+ .or. .not. l%contains('false')) error stop 'tList_contains'
end block list
@@ -244,25 +244,25 @@ subroutine selfTest()
s4 = '4'
allocate(d)
d_pointer => d%asDict()
- if (d%contains('one-two')) error stop 'empty tDict_contains'
- if (d_pointer%contains('one-two')) error stop 'empty tDict_contains(pointer)'
- if (d%get_asInt('one-two',defaultVal=-1) /= -1) error stop 'empty tDict_get'
+ if (d%contains('one-two')) error stop 'empty tDict_contains'
+ if (d_pointer%contains('one-two')) error stop 'empty tDict_contains(pointer)'
+ if (d%get_asInt('one-two',defaultVal=-1) /= -1) error stop 'empty tDict_get'
call d%set('one-two',l)
call d%set('three',s3)
call d%set('four',s4)
- if (d%asFormattedString() /= '{one-two: [1, 2], three: 3, four: 4}') &
- error stop 'tDict_asFormattedString'
- if (d%get_asInt('three') /= 3) error stop 'tDict_get_asInt'
- if (dNeq(d%get_asFloat('three'),3.0_pReal)) error stop 'tDict_get_asFloat'
- if (d%get_asString('three') /= '3') error stop 'tDict_get_asString'
- if (any(d%get_as1dInt('one-two') /= [1,2])) error stop 'tDict_get_as1dInt'
+ if (d%asFormattedStr() /= '{one-two: [1, 2], three: 3, four: 4}') &
+ error stop 'tDict_asFormattedStr'
+ if (d%get_asInt('three') /= 3) error stop 'tDict_get_asInt'
+ if (dNeq(d%get_asReal('three'),3.0_pREAL)) error stop 'tDict_get_asReal'
+ if (d%get_asStr('three') /= '3') error stop 'tDict_get_asStr'
+ if (any(d%get_as1dInt('one-two') /= [1,2])) error stop 'tDict_get_as1dInt'
call d%set('one-two',s4)
- if (d%asFormattedString() /= '{one-two: 4, three: 3, four: 4}') &
- error stop 'tDict_set overwrite'
+ if (d%asFormattedStr() /= '{one-two: 4, three: 3, four: 4}') &
+ error stop 'tDict_set overwrite'
if ( .not. d%contains('one-two') &
.or. .not. d%contains('three') &
.or. .not. d%contains('four') &
- ) error stop 'tDict_contains'
+ ) error stop 'tDict_contains'
end block dict
@@ -299,7 +299,7 @@ end subroutine tScalar_assign__
!--------------------------------------------------------------------------------------------------
!> @brief Format as string (YAML flow style).
!--------------------------------------------------------------------------------------------------
-recursive function tScalar_asFormattedString(self) result(str)
+recursive function tScalar_asFormattedStr(self) result(str)
class (tScalar), intent(in), target :: self
character(len=:), allocatable :: str
@@ -307,7 +307,7 @@ recursive function tScalar_asFormattedString(self) result(str)
str = trim(self%value)
-end function tScalar_asFormattedString
+end function tScalar_asFormattedStr
!--------------------------------------------------------------------------------------------------
@@ -324,7 +324,7 @@ function tNode_asScalar(self) result(scalar)
scalar => self
class default
nullify(scalar)
- call IO_error(706,'"'//trim(self%asFormattedString())//'" is not a scalar')
+ call IO_error(706,'"'//trim(self%asFormattedStr())//'" is not a scalar')
end select
end function tNode_asScalar
@@ -344,7 +344,7 @@ function tNode_asList(self) result(list)
list => self
class default
nullify(list)
- call IO_error(706,'"'//trim(self%asFormattedString())//'" is not a list')
+ call IO_error(706,'"'//trim(self%asFormattedStr())//'" is not a list')
end select
end function tNode_asList
@@ -364,24 +364,24 @@ function tNode_asDict(self) result(dict)
dict => self
class default
nullify(dict)
- call IO_error(706,'"'//trim(self%asFormattedString())//'" is not a dict')
+ call IO_error(706,'"'//trim(self%asFormattedStr())//'" is not a dict')
end select
end function tNode_asDict
!--------------------------------------------------------------------------------------------------
-!> @brief Convert to float.
+!> @brief Convert to real.
!--------------------------------------------------------------------------------------------------
-function tScalar_asFloat(self)
+function tScalar_asReal(self)
class(tScalar), intent(in), target :: self
- real(pReal) :: tScalar_asFloat
+ real(pREAL) :: tScalar_asReal
- tScalar_asFloat = IO_stringAsFloat(self%value)
+ tScalar_asReal = IO_strAsReal(self%value)
-end function tScalar_asFloat
+end function tScalar_asReal
!--------------------------------------------------------------------------------------------------
@@ -393,7 +393,7 @@ function tScalar_asInt(self)
integer :: tScalar_asInt
- tScalar_asInt = IO_stringAsInt(self%value)
+ tScalar_asInt = IO_strAsInt(self%value)
end function tScalar_asInt
@@ -407,7 +407,7 @@ function tScalar_asBool(self)
logical :: tScalar_asBool
- tScalar_asBool = IO_stringAsBool(self%value)
+ tScalar_asBool = IO_strAsBool(self%value)
end function tScalar_asBool
@@ -415,21 +415,21 @@ end function tScalar_asBool
!--------------------------------------------------------------------------------------------------
!> @brief Convert to string.
!--------------------------------------------------------------------------------------------------
-function tScalar_asString(self)
+function tScalar_asStr(self)
class(tScalar), intent(in), target :: self
- character(len=:), allocatable :: tScalar_asString
+ character(len=:), allocatable :: tScalar_asStr
- tScalar_asString = self%value
+ tScalar_asStr = self%value
-end function tScalar_asString
+end function tScalar_asStr
!--------------------------------------------------------------------------------------------------
!> @brief Format as string (YAML flow style).
!--------------------------------------------------------------------------------------------------
-recursive function tList_asFormattedString(self) result(str)
+recursive function tList_asFormattedStr(self) result(str)
class(tList),intent(in),target :: self
@@ -440,12 +440,12 @@ recursive function tList_asFormattedString(self) result(str)
str = '['
item => self%first
do i = 2, self%length
- str = str//item%node%asFormattedString()//', '
+ str = str//item%node%asFormattedStr()//', '
item => item%next
end do
- str = str//item%node%asFormattedString()//']'
+ str = str//item%node%asFormattedStr()//']'
-end function tList_asFormattedString
+end function tList_asFormattedStr
!--------------------------------------------------------------------------------------------------
@@ -476,51 +476,51 @@ end subroutine tList_append
!--------------------------------------------------------------------------------------------------
-!> @brief Convert to float array (1D).
+!> @brief Convert to real array (1D).
!--------------------------------------------------------------------------------------------------
-function tList_as1dFloat(self)
+function tList_as1dReal(self)
class(tList), intent(in), target :: self
- real(pReal), dimension(:), allocatable :: tList_as1dFloat
+ real(pREAL), dimension(:), allocatable :: tList_as1dReal
integer :: i
type(tItem), pointer :: item
type(tScalar), pointer :: scalar
- allocate(tList_as1dFloat(self%length))
+ allocate(tList_as1dReal(self%length))
item => self%first
do i = 1, self%length
scalar => item%node%asScalar()
- tList_as1dFloat(i) = scalar%asFloat()
+ tList_as1dReal(i) = scalar%asReal()
item => item%next
end do
-end function tList_as1dFloat
+end function tList_as1dReal
!--------------------------------------------------------------------------------------------------
-!> @brief Convert to float array (2D).
+!> @brief Convert to real array (2D).
!--------------------------------------------------------------------------------------------------
-function tList_as2dFloat(self)
+function tList_as2dReal(self)
class(tList), intent(in), target :: self
- real(pReal), dimension(:,:), allocatable :: tList_as2dFloat
+ real(pREAL), dimension(:,:), allocatable :: tList_as2dReal
integer :: i
type(tList), pointer :: row_data
row_data => self%get_list(1)
- allocate(tList_as2dFloat(self%length,row_data%length))
+ allocate(tList_as2dReal(self%length,row_data%length))
do i = 1, self%length
row_data => self%get_list(i)
- if (row_data%length /= size(tList_as2dFloat,2)) call IO_error(709,ext_msg='inconsistent column count in tList_as2dFloat')
- tList_as2dFloat(i,:) = self%get_as1dFloat(i)
+ if (row_data%length /= size(tList_as2dReal,2)) call IO_error(709,ext_msg='inconsistent column count in tList_as2dReal')
+ tList_as2dReal(i,:) = self%get_as1dReal(i)
end do
-end function tList_as2dFloat
+end function tList_as2dReal
!--------------------------------------------------------------------------------------------------
@@ -574,13 +574,13 @@ end function tList_as1dBool
!--------------------------------------------------------------------------------------------------
!> @brief Convert to string array (1D).
!--------------------------------------------------------------------------------------------------
-function tList_as1dString(self)
+function tList_as1dStr(self)
class(tList), intent(in), target :: self
#ifdef __GFORTRAN__
- character(len=pStringLen), allocatable, dimension(:) :: tList_as1dString
+ character(len=pSTRLEN), allocatable, dimension(:) :: tList_as1dStr
#else
- character(len=:), allocatable, dimension(:) :: tList_as1dString
+ character(len=:), allocatable, dimension(:) :: tList_as1dStr
#endif
integer :: j
@@ -589,27 +589,27 @@ function tList_as1dString(self)
#ifdef __GFORTRAN__
- allocate(tList_as1dString(self%length))
+ allocate(tList_as1dStr(self%length))
#else
integer :: len_max
len_max = 0
item => self%first
do j = 1, self%length
scalar => item%node%asScalar()
- len_max = max(len_max, len_trim(scalar%asString()))
+ len_max = max(len_max, len_trim(scalar%asStr()))
item => item%next
end do
- allocate(character(len=len_max) :: tList_as1dString(self%length))
+ allocate(character(len=len_max) :: tList_as1dStr(self%length))
#endif
item => self%first
do j = 1, self%length
scalar => item%node%asScalar()
- tList_as1dString(j) = scalar%asString()
+ tList_as1dStr(j) = scalar%asStr()
item => item%next
end do
-end function tList_as1dString
+end function tList_as1dStr
!-------------------------------------------------------------------------------------------------
@@ -652,8 +652,8 @@ function tList_get(self,i) result(node)
integer :: j
- if (i < 1 .or. i > self%length) call IO_error(150,ext_msg='tList_get @ '//IO_intAsString(i) &
- //' of '//IO_intAsString(self%length) )
+ if (i < 1 .or. i > self%length) call IO_error(150,ext_msg='tList_get @ '//IO_intAsStr(i) &
+ //' of '//IO_intAsStr(self%length) )
item => self%first
do j = 2, i
item => item%next
@@ -718,39 +718,39 @@ end function tList_get_dict
!--------------------------------------------------------------------------------------------------
-!> @brief Get scalar by index and convert to float.
+!> @brief Get scalar by index and convert to real.
!--------------------------------------------------------------------------------------------------
-function tList_get_asFloat(self,i) result(nodeAsFloat)
+function tList_get_asReal(self,i) result(nodeAsReal)
class(tList), intent(in) :: self
integer, intent(in) :: i
- real(pReal) :: nodeAsFloat
+ real(pREAL) :: nodeAsReal
class(tScalar), pointer :: scalar
scalar => self%get_scalar(i)
- nodeAsFloat = scalar%asFloat()
+ nodeAsReal = scalar%asReal()
-end function tList_get_asFloat
+end function tList_get_asReal
!--------------------------------------------------------------------------------------------------
-!> @brief Get list by index and convert to float array (1D).
+!> @brief Get list by index and convert to real array (1D).
!--------------------------------------------------------------------------------------------------
-function tList_get_as1dFloat(self,i) result(nodeAs1dFloat)
+function tList_get_as1dReal(self,i) result(nodeAs1dReal)
class(tList), intent(in) :: self
integer, intent(in) :: i
- real(pReal), dimension(:), allocatable :: nodeAs1dFloat
+ real(pREAL), dimension(:), allocatable :: nodeAs1dReal
class(tList), pointer :: list
list => self%get_list(i)
- nodeAs1dFloat = list%as1dFloat()
+ nodeAs1dReal = list%as1dReal()
-end function tList_get_as1dFloat
+end function tList_get_as1dReal
!--------------------------------------------------------------------------------------------------
@@ -828,37 +828,37 @@ end function tList_get_as1dBool
!--------------------------------------------------------------------------------------------------
!> @brief Get scalar by index and convert to string.
!--------------------------------------------------------------------------------------------------
-function tList_get_asString(self,i) result(nodeAsString)
+function tList_get_asStr(self,i) result(nodeAsStr)
class(tList), intent(in) :: self
integer, intent(in) :: i
- character(len=:), allocatable :: nodeAsString
+ character(len=:), allocatable :: nodeAsStr
class(tScalar), pointer :: scalar
scalar => self%get_scalar(i)
- nodeAsString = scalar%asString()
+ nodeAsStr = scalar%asStr()
-end function tList_get_asString
+end function tList_get_asStr
!--------------------------------------------------------------------------------------------------
!> @brief Get list by index and convert to string array (1D).
!--------------------------------------------------------------------------------------------------
-function tList_get_as1dString(self,i) result(nodeAs1dString)
+function tList_get_as1dStr(self,i) result(nodeAs1dStr)
class(tList), intent(in) :: self
integer, intent(in) :: i
- character(len=:), allocatable, dimension(:) :: nodeAs1dString
+ character(len=:), allocatable, dimension(:) :: nodeAs1dStr
type(tList), pointer :: list
list => self%get_list(i)
- nodeAs1dString = list%as1dString()
+ nodeAs1dStr = list%as1dStr()
-end function tList_get_as1dString
+end function tList_get_as1dStr
!--------------------------------------------------------------------------------------------------
@@ -876,7 +876,7 @@ end subroutine tList_finalize
!--------------------------------------------------------------------------------------------------
!> @brief Format as string (YAML flow style).
!--------------------------------------------------------------------------------------------------
-recursive function tDict_asFormattedString(self) result(str)
+recursive function tDict_asFormattedStr(self) result(str)
class(tDict),intent(in),target :: self
@@ -888,12 +888,12 @@ recursive function tDict_asFormattedString(self) result(str)
str = '{'
item => self%first
do i = 2, self%length
- str = str//trim(item%key)//': '//item%node%asFormattedString()//', '
+ str = str//trim(item%key)//': '//item%node%asFormattedStr()//', '
item => item%next
end do
- str = str//trim(item%key)//': '//item%node%asFormattedString()//'}'
+ str = str//trim(item%key)//': '//item%node%asFormattedStr()//'}'
-end function tDict_asFormattedString
+end function tDict_asFormattedStr
!--------------------------------------------------------------------------------------------------
@@ -967,8 +967,8 @@ function tDict_key(self,i) result(key)
type(tItem), pointer :: item
- if (i < 1 .or. i > self%length) call IO_error(150,ext_msg='tDict_key @ '//IO_intAsString(i) &
- //' of '//IO_intAsString(self%length) )
+ if (i < 1 .or. i > self%length) call IO_error(150,ext_msg='tDict_key @ '//IO_intAsStr(i) &
+ //' of '//IO_intAsStr(self%length) )
item => self%first
do j = 2, i
item => item%next
@@ -987,7 +987,7 @@ function tDict_keys(self) result(keys)
class(tDict), intent(in) :: self
character(len=:), dimension(:), allocatable :: keys
- character(len=pStringLen), dimension(:), allocatable :: temp
+ character(len=pSTRLEN), dimension(:), allocatable :: temp
integer :: j, l
@@ -1118,88 +1118,88 @@ end function tDict_get_dict
!--------------------------------------------------------------------------------------------------
-!> @brief Get scalar by key and convert to float.
+!> @brief Get scalar by key and convert to real.
!--------------------------------------------------------------------------------------------------
-function tDict_get_asFloat(self,k,defaultVal) result(nodeAsFloat)
+function tDict_get_asReal(self,k,defaultVal) result(nodeAsReal)
class(tDict), intent(in) :: self
character(len=*), intent(in) :: k
- real(pReal), intent(in), optional :: defaultVal
- real(pReal) :: nodeAsFloat
+ real(pREAL), intent(in), optional :: defaultVal
+ real(pREAL) :: nodeAsReal
type(tScalar), pointer :: scalar
if (self%contains(k)) then
scalar => self%get_scalar(k)
- nodeAsFloat = scalar%asFloat()
+ nodeAsReal = scalar%asReal()
elseif (present(defaultVal)) then
- nodeAsFloat = defaultVal
+ nodeAsReal = defaultVal
else
call IO_error(143,ext_msg=k)
end if
-end function tDict_get_asFloat
+end function tDict_get_asReal
!--------------------------------------------------------------------------------------------------
-!> @brief Get list by key and convert to float array (1D).
+!> @brief Get list by key and convert to real array (1D).
!--------------------------------------------------------------------------------------------------
-function tDict_get_as1dFloat(self,k,defaultVal,requiredSize) result(nodeAs1dFloat)
+function tDict_get_as1dReal(self,k,defaultVal,requiredSize) result(nodeAs1dReal)
class(tDict), intent(in) :: self
character(len=*), intent(in) :: k
- real(pReal), intent(in), dimension(:), optional :: defaultVal
+ real(pREAL), intent(in), dimension(:), optional :: defaultVal
integer, intent(in), optional :: requiredSize
- real(pReal), dimension(:), allocatable :: nodeAs1dFloat
+ real(pREAL), dimension(:), allocatable :: nodeAs1dReal
type(tList), pointer :: list
if (self%contains(k)) then
list => self%get_list(k)
- nodeAs1dFloat = list%as1dFloat()
+ nodeAs1dReal = list%as1dReal()
elseif (present(defaultVal)) then
- nodeAs1dFloat = defaultVal
+ nodeAs1dReal = defaultVal
else
call IO_error(143,ext_msg=k)
end if
if (present(requiredSize)) then
- if (requiredSize /= size(nodeAs1dFloat)) call IO_error(146,ext_msg=k)
+ if (requiredSize /= size(nodeAs1dReal)) call IO_error(146,ext_msg=k)
end if
-end function tDict_get_as1dFloat
+end function tDict_get_as1dReal
!--------------------------------------------------------------------------------------------------
-!> @brief Get list of lists by key and convert to float array (2D).
+!> @brief Get list of lists by key and convert to real array (2D).
!--------------------------------------------------------------------------------------------------
-function tDict_get_as2dFloat(self,k,defaultVal,requiredShape) result(nodeAs2dFloat)
+function tDict_get_as2dReal(self,k,defaultVal,requiredShape) result(nodeAs2dReal)
class(tDict), intent(in) :: self
character(len=*), intent(in) :: k
- real(pReal), intent(in), dimension(:,:), optional :: defaultVal
+ real(pREAL), intent(in), dimension(:,:), optional :: defaultVal
integer, intent(in), dimension(2), optional :: requiredShape
- real(pReal), dimension(:,:), allocatable :: nodeAs2dFloat
+ real(pREAL), dimension(:,:), allocatable :: nodeAs2dReal
type(tList), pointer :: list
if (self%contains(k)) then
list => self%get_list(k)
- nodeAs2dFloat = list%as2dFloat()
+ nodeAs2dReal = list%as2dReal()
elseif (present(defaultVal)) then
- nodeAs2dFloat = defaultVal
+ nodeAs2dReal = defaultVal
else
call IO_error(143,ext_msg=k)
end if
if (present(requiredShape)) then
- if (any(requiredShape /= shape(nodeAs2dFloat))) call IO_error(146,ext_msg=k)
+ if (any(requiredShape /= shape(nodeAs2dReal))) call IO_error(146,ext_msg=k)
end if
-end function tDict_get_as2dFloat
+end function tDict_get_as2dReal
!--------------------------------------------------------------------------------------------------
@@ -1310,61 +1310,61 @@ end function tDict_get_as1dBool
!--------------------------------------------------------------------------------------------------
!> @brief Get scalar by key and convert to string.
!--------------------------------------------------------------------------------------------------
-function tDict_get_asString(self,k,defaultVal) result(nodeAsString)
+function tDict_get_asStr(self,k,defaultVal) result(nodeAsStr)
class(tDict), intent(in) :: self
character(len=*), intent(in) :: k
character(len=*), intent(in), optional :: defaultVal
- character(len=:), allocatable :: nodeAsString
+ character(len=:), allocatable :: nodeAsStr
type(tScalar), pointer :: scalar
if (self%contains(k)) then
scalar => self%get_scalar(k)
- nodeAsString = scalar%asString()
+ nodeAsStr = scalar%asStr()
elseif (present(defaultVal)) then
- nodeAsString = defaultVal
+ nodeAsStr = defaultVal
else
call IO_error(143,ext_msg=k)
end if
-end function tDict_get_asString
+end function tDict_get_asStr
!--------------------------------------------------------------------------------------------------
!> @brief Get list by key and convert to string array (1D).
!--------------------------------------------------------------------------------------------------
-function tDict_get_as1dString(self,k,defaultVal) result(nodeAs1dString)
+function tDict_get_as1dStr(self,k,defaultVal) result(nodeAs1dStr)
class(tDict), intent(in) :: self
character(len=*), intent(in) :: k
character(len=*), intent(in), dimension(:), optional :: defaultVal
- character(len=:), allocatable, dimension(:) :: nodeAs1dString
+ character(len=:), allocatable, dimension(:) :: nodeAs1dStr
type(tList), pointer :: list
if (self%contains(k)) then
list => self%get_list(k)
- nodeAs1dString = list%as1dString()
+ nodeAs1dStr = list%as1dStr()
elseif (present(defaultVal)) then
- nodeAs1dString = defaultVal
+ nodeAs1dStr = defaultVal
else
call IO_error(143,ext_msg=k)
end if
-end function tDict_get_as1dString
+end function tDict_get_as1dStr
#ifdef __GFORTRAN__
!--------------------------------------------------------------------------------------------------
!> @brief Returns string output array (1D) (hack for GNU).
!--------------------------------------------------------------------------------------------------
-function output_as1dString(self) result(output)
+function output_as1dStr(self) result(output)
class(tDict), pointer,intent(in) :: self
- character(len=pStringLen), allocatable, dimension(:) :: output
+ character(len=pSTRLEN), allocatable, dimension(:) :: output
type(tList), pointer :: output_list
integer :: o
@@ -1372,10 +1372,10 @@ function output_as1dString(self) result(output)
output_list => self%get_list('output',defaultVal=emptyList)
allocate(output(output_list%length))
do o = 1, output_list%length
- output(o) = output_list%get_asString(o)
+ output(o) = output_list%get_asStr(o)
end do
-end function output_as1dString
+end function output_as1dStr
#endif
diff --git a/src/config.f90 b/src/config.f90
index 955cc291b..a78e2eb73 100644
--- a/src/config.f90
+++ b/src/config.f90
@@ -84,7 +84,7 @@ function config_listReferences(config,indent) result(references)
else
references = 'references:'
do r = 1, ref%length
- references = references//IO_EOL//filler//'- '//IO_wrapLines(ref%get_asString(r),filler=filler//' ')
+ references = references//IO_EOL//filler//'- '//IO_wrapLines(ref%get_asStr(r),filler=filler//' ')
end do
end if
diff --git a/src/constants.f90 b/src/constants.f90
index 1cdbcc128..29d5ac69a 100644
--- a/src/constants.f90
+++ b/src/constants.f90
@@ -8,9 +8,9 @@ module constants
implicit none(type,external)
public
- real(pReal), parameter :: &
- T_ROOM = 293.15_pReal, & !< Room temperature (20°C) in K (https://en.wikipedia.org/wiki/ISO_1)
- K_B = 1.380649e-23_pReal, & !< Boltzmann constant in J/Kelvin (https://doi.org/10.1351/goldbook)
- N_A = 6.02214076e23_pReal !< Avogadro constant in 1/mol (https://doi.org/10.1351/goldbook)
+ real(pREAL), parameter :: &
+ T_ROOM = 293.15_pREAL, & !< Room temperature (20°C) in K (https://en.wikipedia.org/wiki/ISO_1)
+ K_B = 1.380649e-23_pREAL, & !< Boltzmann constant in J/Kelvin (https://doi.org/10.1351/goldbook)
+ N_A = 6.02214076e23_pREAL !< Avogadro constant in 1/mol (https://doi.org/10.1351/goldbook)
end module constants
diff --git a/src/discretization.f90 b/src/discretization.f90
index ad08c5bff..6afc41811 100644
--- a/src/discretization.f90
+++ b/src/discretization.f90
@@ -18,7 +18,7 @@ module discretization
integer, public, protected, dimension(:), allocatable :: &
discretization_materialAt !ToDo: discretization_ID_material
- real(pReal), public, protected, dimension(:,:), allocatable :: &
+ real(pREAL), public, protected, dimension(:,:), allocatable :: &
discretization_IPcoords0, &
discretization_IPcoords, &
discretization_NodeCoords0, &
@@ -44,7 +44,7 @@ subroutine discretization_init(materialAt,&
integer, dimension(:), intent(in) :: &
materialAt
- real(pReal), dimension(:,:), intent(in) :: &
+ real(pREAL), dimension(:,:), intent(in) :: &
IPcoords0, &
NodeCoords0
integer, optional, intent(in) :: &
@@ -78,7 +78,7 @@ end subroutine discretization_init
!--------------------------------------------------------------------------------------------------
subroutine discretization_result()
- real(pReal), dimension(:,:), allocatable :: u
+ real(pREAL), dimension(:,:), allocatable :: u
call result_closeGroup(result_addGroup('current/geometry'))
@@ -98,7 +98,7 @@ end subroutine discretization_result
!--------------------------------------------------------------------------------------------------
subroutine discretization_setIPcoords(IPcoords)
- real(pReal), dimension(:,:), intent(in) :: IPcoords
+ real(pREAL), dimension(:,:), intent(in) :: IPcoords
discretization_IPcoords = IPcoords
@@ -110,7 +110,7 @@ end subroutine discretization_setIPcoords
!--------------------------------------------------------------------------------------------------
subroutine discretization_setNodeCoords(NodeCoords)
- real(pReal), dimension(:,:), intent(in) :: NodeCoords
+ real(pREAL), dimension(:,:), intent(in) :: NodeCoords
discretization_NodeCoords = NodeCoords
diff --git a/src/geometry_plastic_nonlocal.f90 b/src/geometry_plastic_nonlocal.f90
index e9e7a19cc..c3a6ef7b1 100644
--- a/src/geometry_plastic_nonlocal.f90
+++ b/src/geometry_plastic_nonlocal.f90
@@ -18,13 +18,13 @@ module geometry_plastic_nonlocal
integer, dimension(:,:,:,:), allocatable, protected :: &
geometry_plastic_nonlocal_IPneighborhood !< 6 or less neighboring IPs as [element ID, IP ID, face ID that point to me]
- real(pReal), dimension(:,:), allocatable, protected :: &
+ real(pREAL), dimension(:,:), allocatable, protected :: &
geometry_plastic_nonlocal_IPvolume0 !< volume associated with IP (initially!)
- real(pReal), dimension(:,:,:), allocatable, protected :: &
+ real(pREAL), dimension(:,:,:), allocatable, protected :: &
geometry_plastic_nonlocal_IParea0 !< area of interface to neighboring IP (initially!)
- real(pReal), dimension(:,:,:,:), allocatable, protected :: &
+ real(pREAL), dimension(:,:,:,:), allocatable, protected :: &
geometry_plastic_nonlocal_IPareaNormal0 !< area normal of interface to neighboring IP (initially!)
@@ -54,7 +54,7 @@ end subroutine geometry_plastic_nonlocal_setIPneighborhood
!---------------------------------------------------------------------------------------------------
subroutine geometry_plastic_nonlocal_setIPvolume(IPvolume)
- real(pReal), dimension(:,:), intent(in) :: IPvolume
+ real(pREAL), dimension(:,:), intent(in) :: IPvolume
geometry_plastic_nonlocal_IPvolume0 = IPvolume
@@ -67,7 +67,7 @@ end subroutine geometry_plastic_nonlocal_setIPvolume
!---------------------------------------------------------------------------------------------------
subroutine geometry_plastic_nonlocal_setIParea(IParea)
- real(pReal), dimension(:,:,:), intent(in) :: IParea
+ real(pREAL), dimension(:,:,:), intent(in) :: IParea
geometry_plastic_nonlocal_IParea0 = IParea
@@ -80,7 +80,7 @@ end subroutine geometry_plastic_nonlocal_setIParea
!---------------------------------------------------------------------------------------------------
subroutine geometry_plastic_nonlocal_setIPareaNormal(IPareaNormal)
- real(pReal), dimension(:,:,:,:), intent(in) :: IPareaNormal
+ real(pREAL), dimension(:,:,:,:), intent(in) :: IPareaNormal
geometry_plastic_nonlocal_IPareaNormal0 = IPareaNormal
@@ -117,7 +117,7 @@ subroutine geometry_plastic_nonlocal_result()
call result_openJobFile()
writeVolume: block
- real(pReal), dimension(:), allocatable :: temp
+ real(pREAL), dimension(:), allocatable :: temp
shp = shape(geometry_plastic_nonlocal_IPvolume0)
temp = reshape(geometry_plastic_nonlocal_IPvolume0,[shp(1)*shp(2)])
call result_writeDataset(temp,'geometry','v_0',&
@@ -125,7 +125,7 @@ subroutine geometry_plastic_nonlocal_result()
end block writeVolume
writeAreas: block
- real(pReal), dimension(:,:), allocatable :: temp
+ real(pREAL), dimension(:,:), allocatable :: temp
shp = shape(geometry_plastic_nonlocal_IParea0)
temp = reshape(geometry_plastic_nonlocal_IParea0,[shp(1),shp(2)*shp(3)])
call result_writeDataset(temp,'geometry','a_0',&
@@ -133,7 +133,7 @@ subroutine geometry_plastic_nonlocal_result()
end block writeAreas
writeNormals: block
- real(pReal), dimension(:,:,:), allocatable :: temp
+ real(pREAL), dimension(:,:,:), allocatable :: temp
shp = shape(geometry_plastic_nonlocal_IPareaNormal0)
temp = reshape(geometry_plastic_nonlocal_IPareaNormal0,[shp(1),shp(2),shp(3)*shp(4)])
call result_writeDataset(temp,'geometry','n_0',&
diff --git a/src/grid/DAMASK_grid.f90 b/src/grid/DAMASK_grid.f90
index c77832346..867fb2145 100644
--- a/src/grid/DAMASK_grid.f90
+++ b/src/grid/DAMASK_grid.f90
@@ -40,7 +40,7 @@ program DAMASK_grid
type(tRotation) :: rot !< rotation of BC
type(tBoundaryCondition) :: stress, & !< stress BC
deformation !< deformation BC (dot_F, F, or L)
- real(pReal) :: t, & !< length of increment
+ real(pREAL) :: t, & !< length of increment
r !< ratio of geometric progression
integer :: N, & !< number of increments
f_out, & !< frequency of result writes
@@ -63,12 +63,12 @@ program DAMASK_grid
! loop variables, convergence etc.
integer, parameter :: &
subStepFactor = 2 !< for each substep, divide the last time increment by 2.0
- real(pReal) :: &
- t = 0.0_pReal, & !< elapsed time
- t_0 = 0.0_pReal, & !< begin of interval
- Delta_t = 1.0_pReal, & !< current time interval
- Delta_t_prev = 0.0_pReal, & !< previous time interval
- t_remaining = 0.0_pReal !< remaining time of current load case
+ real(pREAL) :: &
+ t = 0.0_pREAL, & !< elapsed time
+ t_0 = 0.0_pREAL, & !< begin of interval
+ Delta_t = 1.0_pREAL, & !< current time interval
+ Delta_t_prev = 0.0_pREAL, & !< previous time interval
+ t_remaining = 0.0_pREAL !< remaining time of current load case
logical :: &
guess, & !< guess along former trajectory
stagIterate, &
@@ -88,7 +88,7 @@ program DAMASK_grid
maxCutBack, & !< max number of cut backs
stagItMax !< max number of field level staggered iterations
integer(MPI_INTEGER_KIND) :: err_MPI
- character(len=pStringLen) :: &
+ character(len=pSTRLEN) :: &
incInfo
type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases
@@ -158,7 +158,7 @@ program DAMASK_grid
! assign mechanics solver depending on selected type
nActiveFields = 1
- select case (solver%get_asString('mechanical'))
+ select case (solver%get_asStr('mechanical'))
case ('spectral_basic')
mechanical_init => grid_mechanical_spectral_basic_init
mechanical_forward => grid_mechanical_spectral_basic_forward
@@ -181,25 +181,25 @@ program DAMASK_grid
mechanical_restartWrite => grid_mechanical_FEM_restartWrite
case default
- call IO_error(error_ID = 891, ext_msg = trim(solver%get_asString('mechanical')))
+ call IO_error(error_ID = 891, ext_msg = trim(solver%get_asStr('mechanical')))
end select
!--------------------------------------------------------------------------------------------------
! initialize field solver information
- if (solver%get_asString('thermal',defaultVal = 'n/a') == 'spectral') nActiveFields = nActiveFields + 1
- if (solver%get_asString('damage', defaultVal = 'n/a') == 'spectral') nActiveFields = nActiveFields + 1
+ if (solver%get_asStr('thermal',defaultVal = 'n/a') == 'spectral') nActiveFields = nActiveFields + 1
+ if (solver%get_asStr('damage', defaultVal = 'n/a') == 'spectral') nActiveFields = nActiveFields + 1
allocate(solres(nActiveFields))
allocate( ID(nActiveFields))
field = 1
ID(field) = FIELD_MECH_ID ! mechanical active by default
- thermalActive: if (solver%get_asString('thermal',defaultVal = 'n/a') == 'spectral') then
+ thermalActive: if (solver%get_asStr('thermal',defaultVal = 'n/a') == 'spectral') then
field = field + 1
ID(field) = FIELD_THERMAL_ID
end if thermalActive
- damageActive: if (solver%get_asString('damage',defaultVal = 'n/a') == 'spectral') then
+ damageActive: if (solver%get_asStr('damage',defaultVal = 'n/a') == 'spectral') then
field = field + 1
ID(field) = FIELD_DAMAGE_ID
end if damageActive
@@ -234,17 +234,17 @@ program DAMASK_grid
call getMaskedTensor(loadCases(l)%stress%values,loadCases(l)%stress%mask,step_mech%get_list(m))
#endif
end select
- call loadCases(l)%rot%fromAxisAngle(step_mech%get_as1dFloat('R',defaultVal = real([0.0,0.0,1.0,0.0],pReal)),degrees=.true.)
+ call loadCases(l)%rot%fromAxisAngle(step_mech%get_as1dReal('R',defaultVal = real([0.0,0.0,1.0,0.0],pREAL)),degrees=.true.)
end do readMech
if (.not. allocated(loadCases(l)%deformation%myType)) call IO_error(error_ID=837,ext_msg = 'L/dot_F/F missing')
step_discretization => load_step%get_dict('discretization')
- loadCases(l)%t = step_discretization%get_asFloat('t')
+ loadCases(l)%t = step_discretization%get_asReal('t')
loadCases(l)%N = step_discretization%get_asInt ('N')
- loadCases(l)%r = step_discretization%get_asFloat('r',defaultVal= 1.0_pReal)
+ loadCases(l)%r = step_discretization%get_asReal('r',defaultVal= 1.0_pREAL)
loadCases(l)%f_restart = load_step%get_asInt('f_restart', defaultVal=huge(0))
- if (load_step%get_asString('f_out',defaultVal='n/a') == 'none') then
+ if (load_step%get_asStr('f_out',defaultVal='n/a') == 'none') then
loadCases(l)%f_out = huge(0)
else
loadCases(l)%f_out = load_step%get_asInt('f_out', defaultVal=1)
@@ -279,7 +279,7 @@ program DAMASK_grid
if (loadCases(l)%stress%mask(i,j)) then
write(IO_STDOUT,'(2x,12a)',advance='no') ' x '
else
- write(IO_STDOUT,'(2x,f12.4)',advance='no') loadCases(l)%stress%values(i,j)*1e-6_pReal
+ write(IO_STDOUT,'(2x,f12.4)',advance='no') loadCases(l)%stress%values(i,j)*1e-6_pREAL
end if
end do; write(IO_STDOUT,'(/)',advance='no')
end do
@@ -288,13 +288,13 @@ program DAMASK_grid
write(IO_STDOUT,'(2x,a,/,3(3(3x,f12.7,1x)/))',advance='no') 'R:',&
transpose(loadCases(l)%rot%asMatrix())
- if (loadCases(l)%r <= 0.0_pReal) errorID = 833
- if (loadCases(l)%t < 0.0_pReal) errorID = 834
+ if (loadCases(l)%r <= 0.0_pREAL) errorID = 833
+ if (loadCases(l)%t < 0.0_pREAL) errorID = 834
if (loadCases(l)%N < 1) errorID = 835
if (loadCases(l)%f_out < 1) errorID = 836
if (loadCases(l)%f_restart < 1) errorID = 839
- if (dEq(loadCases(l)%r,1.0_pReal,1.e-9_pReal)) then
+ if (dEq(loadCases(l)%r,1.0_pREAL,1.e-9_pREAL)) then
print'(2x,a)', 'r: 1 (constant step width)'
else
print'(2x,a,1x,f0.3)', 'r:', loadCases(l)%r
@@ -345,7 +345,7 @@ program DAMASK_grid
writeUndeformed: if (CLI_restartInc < 1) then
print'(/,1x,a)', '... writing initial configuration to file .................................'
flush(IO_STDOUT)
- call materialpoint_result(0,0.0_pReal)
+ call materialpoint_result(0,0.0_pREAL)
end if writeUndeformed
loadCaseLooping: do l = 1, size(loadCases)
@@ -358,13 +358,13 @@ program DAMASK_grid
!--------------------------------------------------------------------------------------------------
! forwarding time
Delta_t_prev = Delta_t ! last time intervall that brought former inc to an end
- if (dEq(loadCases(l)%r,1.0_pReal,1.e-9_pReal)) then ! linear scale
- Delta_t = loadCases(l)%t/real(loadCases(l)%N,pReal)
+ if (dEq(loadCases(l)%r,1.0_pREAL,1.e-9_pREAL)) then ! linear scale
+ Delta_t = loadCases(l)%t/real(loadCases(l)%N,pREAL)
else
Delta_t = loadCases(l)%t * (loadCases(l)%r**(inc-1)-loadCases(l)%r**inc) &
- / (1.0_pReal-loadCases(l)%r**loadCases(l)%N)
+ / (1.0_pREAL-loadCases(l)%r**loadCases(l)%N)
end if
- Delta_t = Delta_t * real(subStepFactor,pReal)**real(-cutBackLevel,pReal) ! depending on cut back level, decrease time step
+ Delta_t = Delta_t * real(subStepFactor,pREAL)**real(-cutBackLevel,pREAL) ! depending on cut back level, decrease time step
skipping: if (totalIncsCounter <= CLI_restartInc) then ! not yet at restart inc?
t = t + Delta_t ! just advance time, skip already performed calculation
@@ -450,7 +450,7 @@ program DAMASK_grid
stepFraction = (stepFraction - 1) * subStepFactor ! adjust to new denominator
cutBackLevel = cutBackLevel + 1
t = t - Delta_t
- Delta_t = Delta_t/real(subStepFactor,pReal) ! cut timestep
+ Delta_t = Delta_t/real(subStepFactor,pREAL) ! cut timestep
print'(/,1x,a)', 'cutting back '
else ! no more options to continue
if (worldrank == 0) close(statUnit)
@@ -513,7 +513,7 @@ contains
subroutine getMaskedTensor(values,mask,tensor)
- real(pReal), intent(out), dimension(3,3) :: values
+ real(pREAL), intent(out), dimension(3,3) :: values
logical, intent(out), dimension(3,3) :: mask
type(tList), pointer :: tensor
@@ -521,12 +521,12 @@ subroutine getMaskedTensor(values,mask,tensor)
integer :: i,j
- values = 0.0_pReal
+ values = 0.0_pREAL
do i = 1,3
row => tensor%get_list(i)
do j = 1,3
- mask(i,j) = row%get_asString(j) == 'x'
- if (.not. mask(i,j)) values(i,j) = row%get_asFloat(j)
+ mask(i,j) = row%get_asStr(j) == 'x'
+ if (.not. mask(i,j)) values(i,j) = row%get_asReal(j)
end do
end do
diff --git a/src/grid/VTI.f90 b/src/grid/VTI.f90
index cc5a6843b..2749c1bb6 100644
--- a/src/grid/VTI.f90
+++ b/src/grid/VTI.f90
@@ -50,7 +50,7 @@ function VTI_readDataset_real(fileContent,label) result(dataset)
character(len=*), intent(in) :: &
label, &
fileContent
- real(pReal), dimension(:), allocatable :: &
+ real(pREAL), dimension(:), allocatable :: &
dataset
character(len=:), allocatable :: dataType, headerType, base64Str
@@ -143,7 +143,7 @@ subroutine VTI_readCellsSizeOrigin(cells,geomSize,origin, &
integer, dimension(3), intent(out) :: &
cells ! # of cells (across all processes!)
- real(pReal), dimension(3), intent(out) :: &
+ real(pREAL), dimension(3), intent(out) :: &
geomSize, & ! size (across all processes!)
origin ! origin (across all processes!)
character(len=*), intent(in) :: &
@@ -156,7 +156,7 @@ subroutine VTI_readCellsSizeOrigin(cells,geomSize,origin, &
cells = -1
- geomSize = -1.0_pReal
+ geomSize = -1.0_pREAL
inFile = .false.
inImage = .false.
@@ -198,11 +198,11 @@ end subroutine VTI_readCellsSizeOrigin
subroutine cellsSizeOrigin(c,s,o,header)
integer, dimension(3), intent(out) :: c
- real(pReal), dimension(3), intent(out) :: s,o
+ real(pREAL), dimension(3), intent(out) :: s,o
character(len=*), intent(in) :: header
character(len=:), allocatable :: temp
- real(pReal), dimension(3) :: delta
+ real(pREAL), dimension(3) :: delta
integer :: i
@@ -211,16 +211,16 @@ subroutine cellsSizeOrigin(c,s,o,header)
call IO_error(error_ID = 844, ext_msg = 'coordinate order')
temp = getXMLValue(header,'WholeExtent')
- if (any([(IO_intValue(temp,IO_stringPos(temp),i),i=1,5,2)] /= 0)) &
+ if (any([(IO_intValue(temp,IO_strPos(temp),i),i=1,5,2)] /= 0)) &
call IO_error(error_ID = 844, ext_msg = 'coordinate start')
- c = [(IO_intValue(temp,IO_stringPos(temp),i),i=2,6,2)]
+ c = [(IO_intValue(temp,IO_strPos(temp),i),i=2,6,2)]
temp = getXMLValue(header,'Spacing')
- delta = [(IO_floatValue(temp,IO_stringPos(temp),i),i=1,3)]
- s = delta * real(c,pReal)
+ delta = [(IO_realValue(temp,IO_strPos(temp),i),i=1,3)]
+ s = delta * real(c,pREAL)
temp = getXMLValue(header,'Origin')
- o = [(IO_floatValue(temp,IO_stringPos(temp),i),i=1,3)]
+ o = [(IO_realValue(temp,IO_strPos(temp),i),i=1,3)]
end subroutine cellsSizeOrigin
@@ -255,7 +255,7 @@ end function as_Int
!--------------------------------------------------------------------------------------------------
-!> @brief Interpret Base64 string in vtk XML file as real of kind pReal.
+!> @brief Interpret Base64 string in vtk XML file as real of kind pREAL.
!--------------------------------------------------------------------------------------------------
function as_real(base64Str,headerType,compressed,dataType)
@@ -264,18 +264,18 @@ function as_real(base64Str,headerType,compressed,dataType)
dataType ! data type (Int32, Int64, Float32, Float64)
logical, intent(in) :: compressed ! indicate whether data is zlib compressed
- real(pReal), dimension(:), allocatable :: as_real
+ real(pREAL), dimension(:), allocatable :: as_real
select case(dataType)
case('Int32')
- as_real = real(prec_bytesToC_INT32_T(asBytes(base64Str,headerType,compressed)),pReal)
+ as_real = real(prec_bytesToC_INT32_T(asBytes(base64Str,headerType,compressed)),pREAL)
case('Int64')
- as_real = real(prec_bytesToC_INT64_T(asBytes(base64Str,headerType,compressed)),pReal)
+ as_real = real(prec_bytesToC_INT64_T(asBytes(base64Str,headerType,compressed)),pREAL)
case('Float32')
- as_real = real(prec_bytesToC_FLOAT (asBytes(base64Str,headerType,compressed)),pReal)
+ as_real = real(prec_bytesToC_FLOAT (asBytes(base64Str,headerType,compressed)),pREAL)
case('Float64')
- as_real = real(prec_bytesToC_DOUBLE (asBytes(base64Str,headerType,compressed)),pReal)
+ as_real = real(prec_bytesToC_DOUBLE (asBytes(base64Str,headerType,compressed)),pREAL)
case default
call IO_error(844,ext_msg='unknown data type: '//trim(dataType))
end select
diff --git a/src/grid/discretization_grid.f90 b/src/grid/discretization_grid.f90
index ee44f5907..f2f9ca126 100644
--- a/src/grid/discretization_grid.f90
+++ b/src/grid/discretization_grid.f90
@@ -35,9 +35,9 @@ module discretization_grid
integer, public, protected :: &
cells3, & !< (local) cells in 3rd direction
cells3Offset !< (local) cells offset in 3rd direction
- real(pReal), dimension(3), public, protected :: &
+ real(pREAL), dimension(3), public, protected :: &
geomSize !< (global) physical size
- real(pReal), public, protected :: &
+ real(pREAL), public, protected :: &
size3, & !< (local) size in 3rd direction
size3offset !< (local) size offset in 3rd direction
@@ -55,7 +55,7 @@ subroutine discretization_grid_init(restart)
logical, intent(in) :: restart
- real(pReal), dimension(3) :: &
+ real(pREAL), dimension(3) :: &
mySize, & !< domain size of this process
origin !< (global) distance to origin
integer, dimension(3) :: &
@@ -119,8 +119,8 @@ subroutine discretization_grid_init(restart)
cells3 = int(z)
cells3Offset = int(z_offset)
- size3 = geomSize(3)*real(cells3,pReal) /real(cells(3),pReal)
- size3Offset = geomSize(3)*real(cells3Offset,pReal)/real(cells(3),pReal)
+ size3 = geomSize(3)*real(cells3,pREAL) /real(cells(3),pREAL)
+ size3Offset = geomSize(3)*real(cells3Offset,pREAL)/real(cells(3),pREAL)
myGrid = [cells(1:2),cells3]
mySize = [geomSize(1:2),size3]
@@ -156,7 +156,7 @@ subroutine discretization_grid_init(restart)
!--------------------------------------------------------------------------------------------------
! geometry information required by the nonlocal CP model
- call geometry_plastic_nonlocal_setIPvolume(reshape([(product(mySize/real(myGrid,pReal)),j=1,product(myGrid))], &
+ call geometry_plastic_nonlocal_setIPvolume(reshape([(product(mySize/real(myGrid,pREAL)),j=1,product(myGrid))], &
[1,product(myGrid)]))
call geometry_plastic_nonlocal_setIParea (cellSurfaceArea(mySize,myGrid))
call geometry_plastic_nonlocal_setIPareaNormal (cellSurfaceNormal(product(myGrid)))
@@ -171,10 +171,10 @@ end subroutine discretization_grid_init
function IPcoordinates0(cells,geomSize,cells3Offset)
integer, dimension(3), intent(in) :: cells ! cells (for this process!)
- real(pReal), dimension(3), intent(in) :: geomSize ! size (for this process!)
+ real(pREAL), dimension(3), intent(in) :: geomSize ! size (for this process!)
integer, intent(in) :: cells3Offset ! cells(3) offset
- real(pReal), dimension(3,product(cells)) :: ipCoordinates0
+ real(pREAL), dimension(3,product(cells)) :: ipCoordinates0
integer :: &
a,b,c, &
@@ -184,7 +184,7 @@ function IPcoordinates0(cells,geomSize,cells3Offset)
i = 0
do c = 1, cells(3); do b = 1, cells(2); do a = 1, cells(1)
i = i + 1
- IPcoordinates0(1:3,i) = geomSize/real(cells,pReal) * (real([a,b,cells3Offset+c],pReal) -0.5_pReal)
+ IPcoordinates0(1:3,i) = geomSize/real(cells,pREAL) * (real([a,b,cells3Offset+c],pREAL) -0.5_pREAL)
end do; end do; end do
end function IPcoordinates0
@@ -196,10 +196,10 @@ end function IPcoordinates0
pure function nodes0(cells,geomSize,cells3Offset)
integer, dimension(3), intent(in) :: cells ! cells (for this process!)
- real(pReal), dimension(3), intent(in) :: geomSize ! size (for this process!)
+ real(pREAL), dimension(3), intent(in) :: geomSize ! size (for this process!)
integer, intent(in) :: cells3Offset ! cells(3) offset
- real(pReal), dimension(3,product(cells+1)) :: nodes0
+ real(pREAL), dimension(3,product(cells+1)) :: nodes0
integer :: &
a,b,c, &
@@ -208,7 +208,7 @@ pure function nodes0(cells,geomSize,cells3Offset)
n = 0
do c = 0, cells3; do b = 0, cells(2); do a = 0, cells(1)
n = n + 1
- nodes0(1:3,n) = geomSize/real(cells,pReal) * real([a,b,cells3Offset+c],pReal)
+ nodes0(1:3,n) = geomSize/real(cells,pREAL) * real([a,b,cells3Offset+c],pREAL)
end do; end do; end do
end function nodes0
@@ -219,15 +219,15 @@ end function nodes0
!--------------------------------------------------------------------------------------------------
pure function cellSurfaceArea(geomSize,cells)
- real(pReal), dimension(3), intent(in) :: geomSize ! size (for this process!)
+ real(pREAL), dimension(3), intent(in) :: geomSize ! size (for this process!)
integer, dimension(3), intent(in) :: cells ! cells (for this process!)
- real(pReal), dimension(6,1,product(cells)) :: cellSurfaceArea
+ real(pREAL), dimension(6,1,product(cells)) :: cellSurfaceArea
- cellSurfaceArea(1:2,1,:) = geomSize(2)/real(cells(2),pReal) * geomSize(3)/real(cells(3),pReal)
- cellSurfaceArea(3:4,1,:) = geomSize(3)/real(cells(3),pReal) * geomSize(1)/real(cells(1),pReal)
- cellSurfaceArea(5:6,1,:) = geomSize(1)/real(cells(1),pReal) * geomSize(2)/real(cells(2),pReal)
+ cellSurfaceArea(1:2,1,:) = geomSize(2)/real(cells(2),pREAL) * geomSize(3)/real(cells(3),pREAL)
+ cellSurfaceArea(3:4,1,:) = geomSize(3)/real(cells(3),pREAL) * geomSize(1)/real(cells(1),pREAL)
+ cellSurfaceArea(5:6,1,:) = geomSize(1)/real(cells(1),pREAL) * geomSize(2)/real(cells(2),pREAL)
end function cellSurfaceArea
@@ -239,14 +239,14 @@ pure function cellSurfaceNormal(nElems)
integer, intent(in) :: nElems
- real(pReal), dimension(3,6,1,nElems) :: cellSurfaceNormal
+ real(pREAL), dimension(3,6,1,nElems) :: cellSurfaceNormal
- cellSurfaceNormal(1:3,1,1,:) = spread([+1.0_pReal, 0.0_pReal, 0.0_pReal],2,nElems)
- cellSurfaceNormal(1:3,2,1,:) = spread([-1.0_pReal, 0.0_pReal, 0.0_pReal],2,nElems)
- cellSurfaceNormal(1:3,3,1,:) = spread([ 0.0_pReal,+1.0_pReal, 0.0_pReal],2,nElems)
- cellSurfaceNormal(1:3,4,1,:) = spread([ 0.0_pReal,-1.0_pReal, 0.0_pReal],2,nElems)
- cellSurfaceNormal(1:3,5,1,:) = spread([ 0.0_pReal, 0.0_pReal,+1.0_pReal],2,nElems)
- cellSurfaceNormal(1:3,6,1,:) = spread([ 0.0_pReal, 0.0_pReal,-1.0_pReal],2,nElems)
+ cellSurfaceNormal(1:3,1,1,:) = spread([+1.0_pREAL, 0.0_pREAL, 0.0_pREAL],2,nElems)
+ cellSurfaceNormal(1:3,2,1,:) = spread([-1.0_pREAL, 0.0_pREAL, 0.0_pREAL],2,nElems)
+ cellSurfaceNormal(1:3,3,1,:) = spread([ 0.0_pREAL,+1.0_pREAL, 0.0_pREAL],2,nElems)
+ cellSurfaceNormal(1:3,4,1,:) = spread([ 0.0_pREAL,-1.0_pREAL, 0.0_pREAL],2,nElems)
+ cellSurfaceNormal(1:3,5,1,:) = spread([ 0.0_pREAL, 0.0_pREAL,+1.0_pREAL],2,nElems)
+ cellSurfaceNormal(1:3,6,1,:) = spread([ 0.0_pREAL, 0.0_pREAL,-1.0_pREAL],2,nElems)
end function cellSurfaceNormal
@@ -314,9 +314,9 @@ end function IPneighborhood
function discretization_grid_getInitialCondition(label) result(ic)
character(len=*), intent(in) :: label
- real(pReal), dimension(cells(1),cells(2),cells3) :: ic
+ real(pREAL), dimension(cells(1),cells(2),cells3) :: ic
- real(pReal), dimension(:), allocatable :: ic_global, ic_local
+ real(pREAL), dimension(:), allocatable :: ic_global, ic_local
integer(MPI_INTEGER_KIND) :: err_MPI
integer, dimension(worldsize) :: &
diff --git a/src/grid/grid_damage_spectral.f90 b/src/grid/grid_damage_spectral.f90
index 0ba3c5a31..9fce4a2f3 100644
--- a/src/grid/grid_damage_spectral.f90
+++ b/src/grid/grid_damage_spectral.f90
@@ -35,7 +35,7 @@ module grid_damage_spectral
type :: tNumerics
integer :: &
itmax !< maximum number of iterations
- real(pReal) :: &
+ real(pREAL) :: &
phi_min, & !< non-zero residual damage
eps_damage_atol, & !< absolute tolerance for damage evolution
eps_damage_rtol !< relative tolerance for damage evolution
@@ -48,7 +48,7 @@ module grid_damage_spectral
! PETSc data
SNES :: SNES_damage
Vec :: solution_vec
- real(pReal), dimension(:,:,:), allocatable :: &
+ real(pREAL), dimension(:,:,:), allocatable :: &
phi, & !< field of current damage
phi_lastInc, & !< field of previous damage
phi_stagInc !< field of staggered damage
@@ -56,8 +56,8 @@ module grid_damage_spectral
!--------------------------------------------------------------------------------------------------
! reference diffusion tensor, mobility etc.
integer :: totalIter = 0 !< total iteration in current increment
- real(pReal), dimension(3,3) :: K_ref
- real(pReal) :: mu_ref
+ real(pREAL), dimension(3,3) :: K_ref
+ real(pREAL) :: mu_ref
public :: &
grid_damage_spectral_init, &
@@ -75,16 +75,16 @@ subroutine grid_damage_spectral_init()
PetscInt, dimension(0:worldsize-1) :: localK
integer :: i, j, k, ce
DM :: damage_grid
- real(pReal), dimension(:,:,:), pointer :: phi_PETSc
+ real(pREAL), dimension(:,:,:), pointer :: phi_PETSc
Vec :: uBound, lBound
integer(MPI_INTEGER_KIND) :: err_MPI
PetscErrorCode :: err_PETSc
integer(HID_T) :: fileHandle, groupHandle
- real(pReal), dimension(1,product(cells(1:2))*cells3) :: tempN
+ real(pREAL), dimension(1,product(cells(1:2))*cells3) :: tempN
type(tDict), pointer :: &
num_grid, &
num_generic
- character(len=pStringLen) :: &
+ character(len=pSTRLEN) :: &
snes_type
print'(/,1x,a)', '<<<+- grid_spectral_damage init -+>>>'
@@ -98,23 +98,23 @@ subroutine grid_damage_spectral_init()
! read numerical parameters and do sanity checks
num_grid => config_numerics%get_dict('grid',defaultVal=emptyDict)
num%itmax = num_grid%get_asInt ('itmax',defaultVal=250)
- num%eps_damage_atol = num_grid%get_asFloat ('eps_damage_atol',defaultVal=1.0e-2_pReal)
- num%eps_damage_rtol = num_grid%get_asFloat ('eps_damage_rtol',defaultVal=1.0e-6_pReal)
+ num%eps_damage_atol = num_grid%get_asReal ('eps_damage_atol',defaultVal=1.0e-2_pREAL)
+ num%eps_damage_rtol = num_grid%get_asReal ('eps_damage_rtol',defaultVal=1.0e-6_pREAL)
num_generic => config_numerics%get_dict('generic',defaultVal=emptyDict)
- num%phi_min = num_generic%get_asFloat('phi_min', defaultVal=1.0e-6_pReal)
+ num%phi_min = num_generic%get_asReal('phi_min', defaultVal=1.0e-6_pREAL)
- if (num%phi_min < 0.0_pReal) call IO_error(301,ext_msg='phi_min')
+ if (num%phi_min < 0.0_pREAL) call IO_error(301,ext_msg='phi_min')
if (num%itmax <= 1) call IO_error(301,ext_msg='itmax')
- if (num%eps_damage_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_damage_atol')
- if (num%eps_damage_rtol <= 0.0_pReal) call IO_error(301,ext_msg='eps_damage_rtol')
+ if (num%eps_damage_atol <= 0.0_pREAL) call IO_error(301,ext_msg='eps_damage_atol')
+ if (num%eps_damage_rtol <= 0.0_pREAL) call IO_error(301,ext_msg='eps_damage_rtol')
!--------------------------------------------------------------------------------------------------
! set default and user defined options for PETSc
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-damage_snes_type newtonls -damage_snes_mf &
&-damage_snes_ksp_ew -damage_ksp_type fgmres',err_PETSc)
CHKERRQ(err_PETSc)
- call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asString('petsc_options',defaultVal=''),err_PETSc)
+ call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asStr('petsc_options',defaultVal=''),err_PETSc)
CHKERRQ(err_PETSc)
!--------------------------------------------------------------------------------------------------
@@ -162,9 +162,9 @@ subroutine grid_damage_spectral_init()
CHKERRQ(err_PETSc)
call DMGetGlobalVector(damage_grid,uBound,err_PETSc)
CHKERRQ(err_PETSc)
- call VecSet(lBound,0.0_pReal,err_PETSc)
+ call VecSet(lBound,0.0_pREAL,err_PETSc)
CHKERRQ(err_PETSc)
- call VecSet(uBound,1.0_pReal,err_PETSc)
+ call VecSet(uBound,1.0_pREAL,err_PETSc)
CHKERRQ(err_PETSc)
call SNESVISetVariableBounds(SNES_damage,lBound,uBound,err_PETSc) ! variable bounds for variational inequalities
CHKERRQ(err_PETSc)
@@ -208,7 +208,7 @@ end subroutine grid_damage_spectral_init
!--------------------------------------------------------------------------------------------------
function grid_damage_spectral_solution(Delta_t) result(solution)
- real(pReal), intent(in) :: &
+ real(pREAL), intent(in) :: &
Delta_t !< increment in time for current solution
integer :: i, j, k, ce
type(tSolutionState) :: solution
@@ -275,7 +275,7 @@ subroutine grid_damage_spectral_forward(cutBack)
integer :: i, j, k, ce
DM :: dm_local
- real(pReal), dimension(:,:,:), pointer :: phi_PETSc
+ real(pREAL), dimension(:,:,:), pointer :: phi_PETSc
PetscErrorCode :: err_PETSc
@@ -341,15 +341,15 @@ subroutine formResidual(residual_subdomain,x_scal,r,dummy,err_PETSc)
DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: &
residual_subdomain
- real(pReal), dimension(cells(1),cells(2),cells3), intent(in) :: &
+ real(pREAL), dimension(cells(1),cells(2),cells3), intent(in) :: &
x_scal
- real(pReal), dimension(cells(1),cells(2),cells3), intent(out) :: &
+ real(pREAL), dimension(cells(1),cells(2),cells3), intent(out) :: &
r !< residual
PetscObject :: dummy
PetscErrorCode, intent(out) :: err_PETSc
integer :: i, j, k, ce
- real(pReal), dimension(3,cells(1),cells(2),cells3) :: vectorField
+ real(pREAL), dimension(3,cells(1),cells(2),cells3) :: vectorField
phi = x_scal
@@ -384,8 +384,8 @@ subroutine updateReference()
integer(MPI_INTEGER_KIND) :: err_MPI
- K_ref = 0.0_pReal
- mu_ref = 0.0_pReal
+ K_ref = 0.0_pREAL
+ mu_ref = 0.0_pREAL
do ce = 1, product(cells(1:2))*cells3
K_ref = K_ref + homogenization_K_phi(ce)
mu_ref = mu_ref + homogenization_mu_phi(ce)
diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90
index d55f58152..1f2aec682 100644
--- a/src/grid/grid_mech_FEM.f90
+++ b/src/grid/grid_mech_FEM.f90
@@ -41,7 +41,7 @@ module grid_mechanical_FEM
integer :: &
itmin, & !< minimum number of iterations
itmax !< maximum number of iterations
- real(pReal) :: &
+ real(pREAL) :: &
eps_div_atol, & !< absolute tolerance for equilibrium
eps_div_rtol, & !< relative tolerance for equilibrium
eps_stress_atol, & !< absolute tolerance for fullfillment of stress BC
@@ -58,27 +58,27 @@ module grid_mechanical_FEM
!--------------------------------------------------------------------------------------------------
! common pointwise data
- real(pReal), dimension(:,:,:,:,:), allocatable :: F, P_current, F_lastInc
- real(pReal) :: detJ
- real(pReal), dimension(3) :: delta
- real(pReal), dimension(3,8) :: BMat
- real(pReal), dimension(8,8) :: HGMat
+ real(pREAL), dimension(:,:,:,:,:), allocatable :: F, P_current, F_lastInc
+ real(pREAL) :: detJ
+ real(pREAL), dimension(3) :: delta
+ real(pREAL), dimension(3,8) :: BMat
+ real(pREAL), dimension(8,8) :: HGMat
!--------------------------------------------------------------------------------------------------
! stress, stiffness and compliance average etc.
- real(pReal), dimension(3,3) :: &
- F_aimDot = 0.0_pReal, & !< assumed rate of average deformation gradient
+ real(pREAL), dimension(3,3) :: &
+ F_aimDot = 0.0_pREAL, & !< assumed rate of average deformation gradient
F_aim = math_I3, & !< current prescribed deformation gradient
F_aim_lastInc = math_I3, & !< previous average deformation gradient
- P_av = 0.0_pReal, & !< average 1st Piola--Kirchhoff stress
- P_aim = 0.0_pReal
+ P_av = 0.0_pREAL, & !< average 1st Piola--Kirchhoff stress
+ P_aim = 0.0_pREAL
character(len=:), allocatable :: incInfo !< time and increment information
- real(pReal), dimension(3,3,3,3) :: &
- C_volAvg = 0.0_pReal, & !< current volume average stiffness
- C_volAvgLastInc = 0.0_pReal, & !< previous volume average stiffness
- S = 0.0_pReal !< current compliance (filled up with zeros)
+ real(pREAL), dimension(3,3,3,3) :: &
+ C_volAvg = 0.0_pREAL, & !< current volume average stiffness
+ C_volAvgLastInc = 0.0_pREAL, & !< previous volume average stiffness
+ S = 0.0_pREAL !< current compliance (filled up with zeros)
- real(pReal) :: &
+ real(pREAL) :: &
err_BC !< deviation from stress BC
integer :: &
@@ -98,19 +98,19 @@ contains
!--------------------------------------------------------------------------------------------------
subroutine grid_mechanical_FEM_init
- real(pReal), parameter :: HGCoeff = 0.0e-2_pReal
- real(pReal), parameter, dimension(4,8) :: &
- HGcomp = reshape([ 1.0_pReal, 1.0_pReal, 1.0_pReal,-1.0_pReal, &
- 1.0_pReal,-1.0_pReal,-1.0_pReal, 1.0_pReal, &
- -1.0_pReal, 1.0_pReal,-1.0_pReal, 1.0_pReal, &
- -1.0_pReal,-1.0_pReal, 1.0_pReal,-1.0_pReal, &
- -1.0_pReal,-1.0_pReal, 1.0_pReal, 1.0_pReal, &
- -1.0_pReal, 1.0_pReal,-1.0_pReal,-1.0_pReal, &
- 1.0_pReal,-1.0_pReal,-1.0_pReal,-1.0_pReal, &
- 1.0_pReal, 1.0_pReal, 1.0_pReal, 1.0_pReal], [4,8])
- real(pReal), dimension(3,3,3,3) :: devNull
- real(pReal), dimension(3,3,product(cells(1:2))*cells3) :: temp33n
- real(pReal), dimension(3,product(cells(1:2))*cells3) :: temp3n
+ real(pREAL), parameter :: HGCoeff = 0.0e-2_pREAL
+ real(pREAL), parameter, dimension(4,8) :: &
+ HGcomp = reshape([ 1.0_pREAL, 1.0_pREAL, 1.0_pREAL,-1.0_pREAL, &
+ 1.0_pREAL,-1.0_pREAL,-1.0_pREAL, 1.0_pREAL, &
+ -1.0_pREAL, 1.0_pREAL,-1.0_pREAL, 1.0_pREAL, &
+ -1.0_pREAL,-1.0_pREAL, 1.0_pREAL,-1.0_pREAL, &
+ -1.0_pREAL,-1.0_pREAL, 1.0_pREAL, 1.0_pREAL, &
+ -1.0_pREAL, 1.0_pREAL,-1.0_pREAL,-1.0_pREAL, &
+ 1.0_pREAL,-1.0_pREAL,-1.0_pREAL,-1.0_pREAL, &
+ 1.0_pREAL, 1.0_pREAL, 1.0_pREAL, 1.0_pREAL], [4,8])
+ real(pREAL), dimension(3,3,3,3) :: devNull
+ real(pREAL), dimension(3,3,product(cells(1:2))*cells3) :: temp33n
+ real(pREAL), dimension(3,product(cells(1:2))*cells3) :: temp3n
PetscErrorCode :: err_PETSc
integer(MPI_INTEGER_KIND) :: err_MPI
PetscScalar, pointer, dimension(:,:,:,:) :: &
@@ -119,7 +119,7 @@ subroutine grid_mechanical_FEM_init
integer(HID_T) :: fileHandle, groupHandle
type(tDict), pointer :: &
num_grid
- character(len=pStringLen) :: &
+ character(len=pSTRLEN) :: &
extmsg = ''
@@ -129,17 +129,17 @@ subroutine grid_mechanical_FEM_init
! read numerical parameters and do sanity checks
num_grid => config_numerics%get_dict('grid',defaultVal=emptyDict)
- num%eps_div_atol = num_grid%get_asFloat('eps_div_atol', defaultVal=1.0e-4_pReal)
- num%eps_div_rtol = num_grid%get_asFloat('eps_div_rtol', defaultVal=5.0e-4_pReal)
- num%eps_stress_atol = num_grid%get_asFloat('eps_stress_atol',defaultVal=1.0e3_pReal)
- num%eps_stress_rtol = num_grid%get_asFloat('eps_stress_rtol',defaultVal=1.0e-3_pReal)
- num%itmin = num_grid%get_asInt ('itmin',defaultVal=1)
- num%itmax = num_grid%get_asInt ('itmax',defaultVal=250)
+ num%eps_div_atol = num_grid%get_asReal('eps_div_atol', defaultVal=1.0e-4_pREAL)
+ num%eps_div_rtol = num_grid%get_asReal('eps_div_rtol', defaultVal=5.0e-4_pREAL)
+ num%eps_stress_atol = num_grid%get_asReal('eps_stress_atol',defaultVal=1.0e3_pREAL)
+ num%eps_stress_rtol = num_grid%get_asReal('eps_stress_rtol',defaultVal=1.0e-3_pREAL)
+ num%itmin = num_grid%get_asInt ('itmin',defaultVal=1)
+ num%itmax = num_grid%get_asInt ('itmax',defaultVal=250)
- if (num%eps_div_atol <= 0.0_pReal) extmsg = trim(extmsg)//' eps_div_atol'
- if (num%eps_div_rtol < 0.0_pReal) extmsg = trim(extmsg)//' eps_div_rtol'
- if (num%eps_stress_atol <= 0.0_pReal) extmsg = trim(extmsg)//' eps_stress_atol'
- if (num%eps_stress_rtol < 0.0_pReal) extmsg = trim(extmsg)//' eps_stress_rtol'
+ if (num%eps_div_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_div_atol'
+ if (num%eps_div_rtol < 0.0_pREAL) extmsg = trim(extmsg)//' eps_div_rtol'
+ if (num%eps_stress_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_stress_atol'
+ if (num%eps_stress_rtol < 0.0_pREAL) extmsg = trim(extmsg)//' eps_stress_rtol'
if (num%itmax <= 1) extmsg = trim(extmsg)//' itmax'
if (num%itmin > num%itmax .or. num%itmin < 1) extmsg = trim(extmsg)//' itmin'
@@ -152,14 +152,14 @@ subroutine grid_mechanical_FEM_init
&-mechanical_ksp_max_it 25', &
err_PETSc)
CHKERRQ(err_PETSc)
- call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asString('petsc_options',defaultVal=''),err_PETSc)
+ call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asStr('petsc_options',defaultVal=''),err_PETSc)
CHKERRQ(err_PETSc)
!--------------------------------------------------------------------------------------------------
! allocate global fields
- allocate(F (3,3,cells(1),cells(2),cells3),source = 0.0_pReal)
- allocate(P_current (3,3,cells(1),cells(2),cells3),source = 0.0_pReal)
- allocate(F_lastInc (3,3,cells(1),cells(2),cells3),source = 0.0_pReal)
+ allocate(F (3,3,cells(1),cells(2),cells3),source = 0.0_pREAL)
+ allocate(P_current (3,3,cells(1),cells(2),cells3),source = 0.0_pREAL)
+ allocate(F_lastInc (3,3,cells(1),cells(2),cells3),source = 0.0_pREAL)
!--------------------------------------------------------------------------------------------------
! initialize solver specific parts of PETSc
@@ -184,7 +184,7 @@ subroutine grid_mechanical_FEM_init
CHKERRQ(err_PETSc)
call DMsetUp(mechanical_grid,err_PETSc)
CHKERRQ(err_PETSc)
- call DMDASetUniformCoordinates(mechanical_grid,0.0_pReal,geomSize(1),0.0_pReal,geomSize(2),0.0_pReal,geomSize(3),err_PETSc)
+ call DMDASetUniformCoordinates(mechanical_grid,0.0_pREAL,geomSize(1),0.0_pREAL,geomSize(2),0.0_pREAL,geomSize(3),err_PETSc)
CHKERRQ(err_PETSc)
call DMCreateGlobalVector(mechanical_grid,solution_current,err_PETSc)
CHKERRQ(err_PETSc)
@@ -207,18 +207,18 @@ subroutine grid_mechanical_FEM_init
!--------------------------------------------------------------------------------------------------
! init fields
- call VecSet(solution_current,0.0_pReal,err_PETSc)
+ call VecSet(solution_current,0.0_pREAL,err_PETSc)
CHKERRQ(err_PETSc)
- call VecSet(solution_lastInc,0.0_pReal,err_PETSc)
+ call VecSet(solution_lastInc,0.0_pREAL,err_PETSc)
CHKERRQ(err_PETSc)
- call VecSet(solution_rate ,0.0_pReal,err_PETSc)
+ call VecSet(solution_rate ,0.0_pREAL,err_PETSc)
CHKERRQ(err_PETSc)
call DMDAVecGetArrayF90(mechanical_grid,solution_current,u,err_PETSc)
CHKERRQ(err_PETSc)
call DMDAVecGetArrayF90(mechanical_grid,solution_lastInc,u_lastInc,err_PETSc)
CHKERRQ(err_PETSc)
- delta = geomSize/real(cells,pReal) ! grid spacing
+ delta = geomSize/real(cells,pREAL) ! grid spacing
detJ = product(delta) ! cell volume
BMat = reshape(real([-delta(1)**(-1),-delta(2)**(-1),-delta(3)**(-1), &
@@ -228,10 +228,10 @@ subroutine grid_mechanical_FEM_init
-delta(1)**(-1),-delta(2)**(-1), delta(3)**(-1), &
delta(1)**(-1),-delta(2)**(-1), delta(3)**(-1), &
-delta(1)**(-1), delta(2)**(-1), delta(3)**(-1), &
- delta(1)**(-1), delta(2)**(-1), delta(3)**(-1)],pReal), [3,8])/4.0_pReal ! shape function derivative matrix
+ delta(1)**(-1), delta(2)**(-1), delta(3)**(-1)],pREAL), [3,8])/4.0_pREAL ! shape function derivative matrix
HGMat = matmul(transpose(HGcomp),HGcomp) &
- * HGCoeff*(delta(1)*delta(2) + delta(2)*delta(3) + delta(3)*delta(1))/16.0_pReal ! hourglass stabilization matrix
+ * HGCoeff*(delta(1)*delta(2) + delta(2)*delta(3) + delta(3)*delta(1))/16.0_pREAL ! hourglass stabilization matrix
!--------------------------------------------------------------------------------------------------
! init fields
@@ -271,7 +271,7 @@ subroutine grid_mechanical_FEM_init
call utilities_updateCoords(F)
call utilities_constitutiveResponse(P_current,P_av,C_volAvg,devNull, & ! stress field, stress avg, global average of stiffness and (min+max)/2
F, & ! target F
- 0.0_pReal) ! time increment
+ 0.0_pREAL) ! time increment
call DMDAVecRestoreArrayF90(mechanical_grid,solution_current,u,err_PETSc)
CHKERRQ(err_PETSc)
call DMDAVecRestoreArrayF90(mechanical_grid,solution_lastInc,u_lastInc,err_PETSc)
@@ -340,7 +340,7 @@ subroutine grid_mechanical_FEM_forward(cutBack,guess,Delta_t,Delta_t_old,t_remai
logical, intent(in) :: &
cutBack, &
guess
- real(pReal), intent(in) :: &
+ real(pREAL), intent(in) :: &
Delta_t_old, &
Delta_t, &
t_remaining !< remaining time of current load case
@@ -365,29 +365,29 @@ subroutine grid_mechanical_FEM_forward(cutBack,guess,Delta_t,Delta_t_old,t_remai
else
C_volAvgLastInc = C_volAvg
- F_aimDot = merge(merge(.0_pReal,(F_aim-F_aim_lastInc)/Delta_t_old,stress_BC%mask),.0_pReal,guess) ! estimate deformation rate for prescribed stress components
+ F_aimDot = merge(merge(.0_pREAL,(F_aim-F_aim_lastInc)/Delta_t_old,stress_BC%mask),.0_pREAL,guess) ! estimate deformation rate for prescribed stress components
F_aim_lastInc = F_aim
!-----------------------------------------------------------------------------------------------
! calculate rate for aim
if (deformation_BC%myType=='L') then ! calculate F_aimDot from given L and current F
F_aimDot = F_aimDot &
- + matmul(merge(.0_pReal,deformation_BC%values,deformation_BC%mask),F_aim_lastInc)
+ + matmul(merge(.0_pREAL,deformation_BC%values,deformation_BC%mask),F_aim_lastInc)
elseif (deformation_BC%myType=='dot_F') then ! F_aimDot is prescribed
F_aimDot = F_aimDot &
- + merge(.0_pReal,deformation_BC%values,deformation_BC%mask)
+ + merge(.0_pREAL,deformation_BC%values,deformation_BC%mask)
elseif (deformation_BC%myType=='F') then ! aim at end of load case is prescribed
F_aimDot = F_aimDot &
- + merge(.0_pReal,(deformation_BC%values - F_aim_lastInc)/t_remaining,deformation_BC%mask)
+ + merge(.0_pREAL,(deformation_BC%values - F_aim_lastInc)/t_remaining,deformation_BC%mask)
end if
if (guess) then
- call VecWAXPY(solution_rate,-1.0_pReal,solution_lastInc,solution_current,err_PETSc)
+ call VecWAXPY(solution_rate,-1.0_pREAL,solution_lastInc,solution_current,err_PETSc)
CHKERRQ(err_PETSc)
- call VecScale(solution_rate,1.0_pReal/Delta_t_old,err_PETSc)
+ call VecScale(solution_rate,1.0_pREAL/Delta_t_old,err_PETSc)
CHKERRQ(err_PETSc)
else
- call VecSet(solution_rate,0.0_pReal,err_PETSc)
+ call VecSet(solution_rate,0.0_pREAL,err_PETSc)
CHKERRQ(err_PETSc)
end if
call VecCopy(solution_current,solution_lastInc,err_PETSc)
@@ -402,9 +402,9 @@ subroutine grid_mechanical_FEM_forward(cutBack,guess,Delta_t,Delta_t_old,t_remai
! update average and local deformation gradients
F_aim = F_aim_lastInc + F_aimDot * Delta_t
if (stress_BC%myType=='P') P_aim = P_aim &
- + merge(.0_pReal,(stress_BC%values - P_aim)/t_remaining,stress_BC%mask)*Delta_t
+ + merge(.0_pREAL,(stress_BC%values - P_aim)/t_remaining,stress_BC%mask)*Delta_t
if (stress_BC%myType=='dot_P') P_aim = P_aim &
- + merge(.0_pReal,stress_BC%values,stress_BC%mask)*Delta_t
+ + merge(.0_pREAL,stress_BC%values,stress_BC%mask)*Delta_t
call VecAXPY(solution_current,Delta_t,solution_rate,err_PETSc)
CHKERRQ(err_PETSc)
@@ -493,7 +493,7 @@ subroutine converged(snes_local,PETScIter,devNull1,devNull2,fnorm,reason,dummy,e
SNESConvergedReason :: reason
PetscObject :: dummy
PetscErrorCode :: err_PETSc
- real(pReal) :: &
+ real(pREAL) :: &
err_div, &
divTol, &
BCTol
@@ -502,7 +502,7 @@ subroutine converged(snes_local,PETScIter,devNull1,devNull2,fnorm,reason,dummy,e
divTol = max(maxval(abs(P_av))*num%eps_div_rtol, num%eps_div_atol)
BCTol = max(maxval(abs(P_av))*num%eps_stress_rtol, num%eps_stress_atol)
- if ((totalIter >= num%itmin .and. all([err_div/divTol, err_BC/BCTol] < 1.0_pReal)) &
+ if ((totalIter >= num%itmin .and. all([err_div/divTol, err_BC/BCTol] < 1.0_pREAL)) &
.or. terminallyIll) then
reason = 1
elseif (totalIter >= num%itmax) then
@@ -534,14 +534,14 @@ subroutine formResidual(da_local,x_local, &
PetscObject :: dummy
PetscErrorCode :: err_PETSc
- real(pReal), pointer,dimension(:,:,:,:) :: x_scal, r
- real(pReal), dimension(8,3) :: x_elem, f_elem
+ real(pREAL), pointer,dimension(:,:,:,:) :: x_scal, r
+ real(pREAL), dimension(8,3) :: x_elem, f_elem
PetscInt :: i, ii, j, jj, k, kk, ctr, ele
PetscInt :: &
PETScIter, &
nfuncs
integer(MPI_INTEGER_KIND) :: err_MPI
- real(pReal), dimension(3,3,3,3) :: devNull
+ real(pREAL), dimension(3,3,3,3) :: devNull
call SNESGetNumberFunctionEvals(SNES_mechanical,nfuncs,err_PETSc)
CHKERRQ(err_PETSc)
@@ -556,7 +556,7 @@ subroutine formResidual(da_local,x_local, &
newIteration: if (totalIter <= PETScIter) then
totalIter = totalIter + 1
print'(1x,a,3(a,i0))', trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter+1, '≤', num%itmax
- if (any(dNeq(params%rotation_BC%asQuaternion(), real([1.0, 0.0, 0.0, 0.0],pReal)))) &
+ if (any(dNeq(params%rotation_BC%asQuaternion(), real([1.0, 0.0, 0.0, 0.0],pREAL)))) &
print'(/,1x,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
'deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.))
print'(/,1x,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
@@ -590,7 +590,7 @@ subroutine formResidual(da_local,x_local, &
!--------------------------------------------------------------------------------------------------
! stress BC handling
F_aim = F_aim - math_mul3333xx33(S, P_av - P_aim) ! S = 0.0 for no bc
- err_BC = maxval(abs(merge(.0_pReal,P_av - P_aim,params%stress_mask)))
+ err_BC = maxval(abs(merge(.0_pREAL,P_av - P_aim,params%stress_mask)))
!--------------------------------------------------------------------------------------------------
! constructing residual
@@ -599,7 +599,7 @@ subroutine formResidual(da_local,x_local, &
call DMDAVecGetArrayF90(da_local,x_local,x_scal,err_PETSc)
CHKERRQ(err_PETSc)
ele = 0
- r = 0.0_pReal
+ r = 0.0_pREAL
do k = cells3Offset+1, cells3Offset+cells3; do j = 1, cells(2); do i = 1, cells(1)
ctr = 0
do kk = -1, 0; do jj = -1, 0; do ii = -1, 0
@@ -610,7 +610,7 @@ subroutine formResidual(da_local,x_local, &
f_elem = matmul(transpose(BMat),transpose(P_current(1:3,1:3,i,j,k-cells3Offset)))*detJ + &
matmul(HGMat,x_elem)*(homogenization_dPdF(1,1,1,1,ele) + &
homogenization_dPdF(2,2,2,2,ele) + &
- homogenization_dPdF(3,3,3,3,ele))/3.0_pReal
+ homogenization_dPdF(3,3,3,3,ele))/3.0_pREAL
ctr = 0
do kk = -1, 0; do jj = -1, 0; do ii = -1, 0
ctr = ctr + 1
@@ -623,16 +623,16 @@ subroutine formResidual(da_local,x_local, &
!--------------------------------------------------------------------------------------------------
! applying boundary conditions
if (cells3Offset == 0) then
- r(0:2,0, 0, 0) = 0.0_pReal
- r(0:2,cells(1),0, 0) = 0.0_pReal
- r(0:2,0, cells(2),0) = 0.0_pReal
- r(0:2,cells(1),cells(2),0) = 0.0_pReal
+ r(0:2,0, 0, 0) = 0.0_pREAL
+ r(0:2,cells(1),0, 0) = 0.0_pREAL
+ r(0:2,0, cells(2),0) = 0.0_pREAL
+ r(0:2,cells(1),cells(2),0) = 0.0_pREAL
end if
if (cells3+cells3Offset == cells(3)) then
- r(0:2,0, 0, cells(3)) = 0.0_pReal
- r(0:2,cells(1),0, cells(3)) = 0.0_pReal
- r(0:2,0, cells(2),cells(3)) = 0.0_pReal
- r(0:2,cells(1),cells(2),cells(3)) = 0.0_pReal
+ r(0:2,0, 0, cells(3)) = 0.0_pREAL
+ r(0:2,cells(1),0, cells(3)) = 0.0_pREAL
+ r(0:2,0, cells(2),cells(3)) = 0.0_pREAL
+ r(0:2,cells(1),cells(2),cells(3)) = 0.0_pREAL
end if
call DMDAVecRestoreArrayF90(da_local,f_local,r,err_PETSc)
CHKERRQ(err_PETSc)
@@ -652,17 +652,17 @@ subroutine formJacobian(da_local,x_local,Jac_pre,Jac,dummy,err_PETSc)
PetscErrorCode :: err_PETSc
MatStencil,dimension(4,24) :: row, col
- real(pReal),pointer,dimension(:,:,:,:) :: x_scal
- real(pReal),dimension(24,24) :: K_ele
- real(pReal),dimension(9,24) :: BMatFull
+ real(pREAL),pointer,dimension(:,:,:,:) :: x_scal
+ real(pREAL),dimension(24,24) :: K_ele
+ real(pREAL),dimension(9,24) :: BMatFull
PetscInt :: i, ii, j, jj, k, kk, ctr, ce
PetscInt,dimension(3),parameter :: rows = [0, 1, 2]
- real(pReal) :: diag
+ real(pREAL) :: diag
MatNullSpace :: matnull
Vec :: coordinates
- BMatFull = 0.0_pReal
+ BMatFull = 0.0_pREAL
BMatFull(1:3,1 :8 ) = BMat
BMatFull(4:6,9 :16) = BMat
BMatFull(7:9,17:24) = BMat
@@ -692,16 +692,16 @@ subroutine formJacobian(da_local,x_local,Jac_pre,Jac,dummy,err_PETSc)
end do; end do; end do
row = col
ce = ce + 1
- K_ele = 0.0_pReal
+ K_ele = 0.0_pREAL
K_ele(1 :8 ,1 :8 ) = HGMat*(homogenization_dPdF(1,1,1,1,ce) + &
homogenization_dPdF(2,2,2,2,ce) + &
- homogenization_dPdF(3,3,3,3,ce))/3.0_pReal
+ homogenization_dPdF(3,3,3,3,ce))/3.0_pREAL
K_ele(9 :16,9 :16) = HGMat*(homogenization_dPdF(1,1,1,1,ce) + &
homogenization_dPdF(2,2,2,2,ce) + &
- homogenization_dPdF(3,3,3,3,ce))/3.0_pReal
+ homogenization_dPdF(3,3,3,3,ce))/3.0_pREAL
K_ele(17:24,17:24) = HGMat*(homogenization_dPdF(1,1,1,1,ce) + &
homogenization_dPdF(2,2,2,2,ce) + &
- homogenization_dPdF(3,3,3,3,ce))/3.0_pReal
+ homogenization_dPdF(3,3,3,3,ce))/3.0_pREAL
K_ele = K_ele + &
matmul(transpose(BMatFull), &
matmul(reshape(reshape(homogenization_dPdF(1:3,1:3,1:3,1:3,ce), &
diff --git a/src/grid/grid_mech_spectral_basic.f90 b/src/grid/grid_mech_spectral_basic.f90
index f2a009afb..71ca438ac 100644
--- a/src/grid/grid_mech_spectral_basic.f90
+++ b/src/grid/grid_mech_spectral_basic.f90
@@ -40,7 +40,7 @@ module grid_mechanical_spectral_basic
integer :: &
itmin, & !< minimum number of iterations
itmax !< maximum number of iterations
- real(pReal) :: &
+ real(pREAL) :: &
eps_div_atol, & !< absolute tolerance for equilibrium
eps_div_rtol, & !< relative tolerance for equilibrium
eps_stress_atol, & !< absolute tolerance for fullfillment of stress BC
@@ -57,28 +57,28 @@ module grid_mechanical_spectral_basic
!--------------------------------------------------------------------------------------------------
! common pointwise data
- real(pReal), dimension(:,:,:,:,:), allocatable :: &
+ real(pREAL), dimension(:,:,:,:,:), allocatable :: &
F_lastInc, & !< field of previous compatible deformation gradients
Fdot !< field of assumed rate of compatible deformation gradient
!--------------------------------------------------------------------------------------------------
! stress, stiffness and compliance average etc.
- real(pReal), dimension(3,3) :: &
- F_aimDot = 0.0_pReal, & !< assumed rate of average deformation gradient
+ real(pREAL), dimension(3,3) :: &
+ F_aimDot = 0.0_pREAL, & !< assumed rate of average deformation gradient
F_aim = math_I3, & !< current prescribed deformation gradient
F_aim_lastInc = math_I3, & !< previous average deformation gradient
- P_av = 0.0_pReal, & !< average 1st Piola--Kirchhoff stress
- P_aim = 0.0_pReal
+ P_av = 0.0_pREAL, & !< average 1st Piola--Kirchhoff stress
+ P_aim = 0.0_pREAL
character(len=:), allocatable :: incInfo !< time and increment information
- real(pReal), dimension(3,3,3,3) :: &
- C_volAvg = 0.0_pReal, & !< current volume average stiffness
- C_volAvgLastInc = 0.0_pReal, & !< previous volume average stiffness
- C_minMaxAvg = 0.0_pReal, & !< current (min+max)/2 stiffness
- C_minMaxAvgLastInc = 0.0_pReal, & !< previous (min+max)/2 stiffness
- C_minMaxAvgRestart = 0.0_pReal, & !< (min+max)/2 stiffnes (restart)
- S = 0.0_pReal !< current compliance (filled up with zeros)
+ real(pREAL), dimension(3,3,3,3) :: &
+ C_volAvg = 0.0_pREAL, & !< current volume average stiffness
+ C_volAvgLastInc = 0.0_pREAL, & !< previous volume average stiffness
+ C_minMaxAvg = 0.0_pREAL, & !< current (min+max)/2 stiffness
+ C_minMaxAvgLastInc = 0.0_pREAL, & !< previous (min+max)/2 stiffness
+ C_minMaxAvgRestart = 0.0_pREAL, & !< (min+max)/2 stiffnes (restart)
+ S = 0.0_pREAL !< current compliance (filled up with zeros)
- real(pReal) :: &
+ real(pREAL) :: &
err_BC, & !< deviation from stress BC
err_div !< RMS of div of P
@@ -105,17 +105,17 @@ contains
!--------------------------------------------------------------------------------------------------
subroutine grid_mechanical_spectral_basic_init()
- real(pReal), dimension(3,3,cells(1),cells(2),cells3) :: P
+ real(pREAL), dimension(3,3,cells(1),cells(2),cells3) :: P
PetscErrorCode :: err_PETSc
integer(MPI_INTEGER_KIND) :: err_MPI
- real(pReal), pointer, dimension(:,:,:,:) :: &
+ real(pREAL), pointer, dimension(:,:,:,:) :: &
F ! pointer to solution data
PetscInt, dimension(0:worldsize-1) :: localK
- real(pReal), dimension(3,3,product(cells(1:2))*cells3) :: temp33n
+ real(pREAL), dimension(3,3,product(cells(1:2))*cells3) :: temp33n
integer(HID_T) :: fileHandle, groupHandle
type(tDict), pointer :: &
num_grid
- character(len=pStringLen) :: &
+ character(len=pSTRLEN) :: &
extmsg = ''
@@ -131,18 +131,18 @@ subroutine grid_mechanical_spectral_basic_init()
! read numerical parameters and do sanity checks
num_grid => config_numerics%get_dict('grid',defaultVal=emptyDict)
- num%update_gamma = num_grid%get_asBool ('update_gamma', defaultVal=.false.)
- num%eps_div_atol = num_grid%get_asFloat('eps_div_atol', defaultVal=1.0e-4_pReal)
- num%eps_div_rtol = num_grid%get_asFloat('eps_div_rtol', defaultVal=5.0e-4_pReal)
- num%eps_stress_atol = num_grid%get_asFloat('eps_stress_atol',defaultVal=1.0e3_pReal)
- num%eps_stress_rtol = num_grid%get_asFloat('eps_stress_rtol',defaultVal=1.0e-3_pReal)
- num%itmin = num_grid%get_asInt ('itmin',defaultVal=1)
- num%itmax = num_grid%get_asInt ('itmax',defaultVal=250)
+ num%update_gamma = num_grid%get_asBool('update_gamma', defaultVal=.false.)
+ num%eps_div_atol = num_grid%get_asReal('eps_div_atol', defaultVal=1.0e-4_pREAL)
+ num%eps_div_rtol = num_grid%get_asReal('eps_div_rtol', defaultVal=5.0e-4_pREAL)
+ num%eps_stress_atol = num_grid%get_asReal('eps_stress_atol',defaultVal=1.0e3_pREAL)
+ num%eps_stress_rtol = num_grid%get_asReal('eps_stress_rtol',defaultVal=1.0e-3_pREAL)
+ num%itmin = num_grid%get_asInt ('itmin',defaultVal=1)
+ num%itmax = num_grid%get_asInt ('itmax',defaultVal=250)
- if (num%eps_div_atol <= 0.0_pReal) extmsg = trim(extmsg)//' eps_div_atol'
- if (num%eps_div_rtol < 0.0_pReal) extmsg = trim(extmsg)//' eps_div_rtol'
- if (num%eps_stress_atol <= 0.0_pReal) extmsg = trim(extmsg)//' eps_stress_atol'
- if (num%eps_stress_rtol < 0.0_pReal) extmsg = trim(extmsg)//' eps_stress_rtol'
+ if (num%eps_div_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_div_atol'
+ if (num%eps_div_rtol < 0.0_pREAL) extmsg = trim(extmsg)//' eps_div_rtol'
+ if (num%eps_stress_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_stress_atol'
+ if (num%eps_stress_rtol < 0.0_pREAL) extmsg = trim(extmsg)//' eps_stress_rtol'
if (num%itmax <= 1) extmsg = trim(extmsg)//' itmax'
if (num%itmin > num%itmax .or. num%itmin < 1) extmsg = trim(extmsg)//' itmin'
@@ -152,13 +152,13 @@ subroutine grid_mechanical_spectral_basic_init()
! set default and user defined options for PETSc
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-mechanical_snes_type ngmres',err_PETSc)
CHKERRQ(err_PETSc)
- call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asString('petsc_options',defaultVal=''),err_PETSc)
+ call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asStr('petsc_options',defaultVal=''),err_PETSc)
CHKERRQ(err_PETSc)
!--------------------------------------------------------------------------------------------------
! allocate global fields
- allocate(F_lastInc(3,3,cells(1),cells(2),cells3),source = 0.0_pReal)
- allocate(Fdot (3,3,cells(1),cells(2),cells3),source = 0.0_pReal)
+ allocate(F_lastInc(3,3,cells(1),cells(2),cells3),source = 0.0_pREAL)
+ allocate(Fdot (3,3,cells(1),cells(2),cells3),source = 0.0_pREAL)
!--------------------------------------------------------------------------------------------------
! initialize solver specific parts of PETSc
@@ -231,7 +231,7 @@ subroutine grid_mechanical_spectral_basic_init()
call utilities_updateCoords(reshape(F,shape(F_lastInc)))
call utilities_constitutiveResponse(P,P_av,C_volAvg,C_minMaxAvg, & ! stress field, stress avg, global average of stiffness and (min+max)/2
reshape(F,shape(F_lastInc)), & ! target F
- 0.0_pReal) ! time increment
+ 0.0_pREAL) ! time increment
call DMDAVecRestoreArrayF90(da,solution_vec,F,err_PETSc) ! deassociate pointer
CHKERRQ(err_PETSc)
@@ -305,7 +305,7 @@ subroutine grid_mechanical_spectral_basic_forward(cutBack,guess,Delta_t,Delta_t_
logical, intent(in) :: &
cutBack, &
guess
- real(pReal), intent(in) :: &
+ real(pREAL), intent(in) :: &
Delta_t_old, &
Delta_t, &
t_remaining !< remaining time of current load case
@@ -315,7 +315,7 @@ subroutine grid_mechanical_spectral_basic_forward(cutBack,guess,Delta_t,Delta_t_
type(tRotation), intent(in) :: &
rotation_BC
PetscErrorCode :: err_PETSc
- real(pReal), pointer, dimension(:,:,:,:) :: F
+ real(pREAL), pointer, dimension(:,:,:,:) :: F
call DMDAVecGetArrayF90(da,solution_vec,F,err_PETSc)
@@ -328,20 +328,20 @@ subroutine grid_mechanical_spectral_basic_forward(cutBack,guess,Delta_t,Delta_t_
C_volAvgLastInc = C_volAvg
C_minMaxAvgLastInc = C_minMaxAvg
- F_aimDot = merge(merge(.0_pReal,(F_aim-F_aim_lastInc)/Delta_t_old,stress_BC%mask),.0_pReal,guess) ! estimate deformation rate for prescribed stress components
+ F_aimDot = merge(merge(.0_pREAL,(F_aim-F_aim_lastInc)/Delta_t_old,stress_BC%mask),.0_pREAL,guess) ! estimate deformation rate for prescribed stress components
F_aim_lastInc = F_aim
!-----------------------------------------------------------------------------------------------
! calculate rate for aim
if (deformation_BC%myType=='L') then ! calculate F_aimDot from given L and current F
F_aimDot = F_aimDot &
- + matmul(merge(.0_pReal,deformation_BC%values,deformation_BC%mask),F_aim_lastInc)
+ + matmul(merge(.0_pREAL,deformation_BC%values,deformation_BC%mask),F_aim_lastInc)
elseif (deformation_BC%myType=='dot_F') then ! F_aimDot is prescribed
F_aimDot = F_aimDot &
- + merge(.0_pReal,deformation_BC%values,deformation_BC%mask)
+ + merge(.0_pREAL,deformation_BC%values,deformation_BC%mask)
elseif (deformation_BC%myType=='F') then ! aim at end of load case is prescribed
F_aimDot = F_aimDot &
- + merge(.0_pReal,(deformation_BC%values - F_aim_lastInc)/t_remaining,deformation_BC%mask)
+ + merge(.0_pREAL,(deformation_BC%values - F_aim_lastInc)/t_remaining,deformation_BC%mask)
end if
Fdot = utilities_calculateRate(guess, &
@@ -356,9 +356,9 @@ subroutine grid_mechanical_spectral_basic_forward(cutBack,guess,Delta_t,Delta_t_
! update average and local deformation gradients
F_aim = F_aim_lastInc + F_aimDot * Delta_t
if (stress_BC%myType=='P') P_aim = P_aim &
- + merge(.0_pReal,(stress_BC%values - P_aim)/t_remaining,stress_BC%mask)*Delta_t
+ + merge(.0_pREAL,(stress_BC%values - P_aim)/t_remaining,stress_BC%mask)*Delta_t
if (stress_BC%myType=='dot_P') P_aim = P_aim &
- + merge(.0_pReal,stress_BC%values,stress_BC%mask)*Delta_t
+ + merge(.0_pREAL,stress_BC%values,stress_BC%mask)*Delta_t
F = reshape(utilities_forwardField(Delta_t,F_lastInc,Fdot, & ! estimate of F at end of time+Delta_t that matches rotated F_aim on average
rotation_BC%rotate(F_aim,active=.true.)),[9,cells(1),cells(2),cells3])
@@ -380,7 +380,7 @@ end subroutine grid_mechanical_spectral_basic_forward
subroutine grid_mechanical_spectral_basic_updateCoords
PetscErrorCode :: err_PETSc
- real(pReal), dimension(:,:,:,:), pointer :: F
+ real(pREAL), dimension(:,:,:,:), pointer :: F
call DMDAVecGetArrayF90(da,solution_vec,F,err_PETSc)
CHKERRQ(err_PETSc)
@@ -398,7 +398,7 @@ subroutine grid_mechanical_spectral_basic_restartWrite
PetscErrorCode :: err_PETSc
integer(HID_T) :: fileHandle, groupHandle
- real(pReal), dimension(:,:,:,:), pointer :: F
+ real(pREAL), dimension(:,:,:,:), pointer :: F
call DMDAVecGetArrayF90(da,solution_vec,F,err_PETSc)
CHKERRQ(err_PETSc)
@@ -448,14 +448,14 @@ subroutine converged(snes_local,PETScIter,devNull1,devNull2,devNull3,reason,dumm
SNESConvergedReason :: reason
PetscObject :: dummy
PetscErrorCode :: err_PETSc
- real(pReal) :: &
+ real(pREAL) :: &
divTol, &
BCTol
divTol = max(maxval(abs(P_av))*num%eps_div_rtol, num%eps_div_atol)
BCTol = max(maxval(abs(P_av))*num%eps_stress_rtol, num%eps_stress_atol)
- if ((totalIter >= num%itmin .and. all([err_div/divTol, err_BC/BCTol] < 1.0_pReal)) &
+ if ((totalIter >= num%itmin .and. all([err_div/divTol, err_BC/BCTol] < 1.0_pREAL)) &
.or. terminallyIll) then
reason = 1
elseif (totalIter >= num%itmax) then
@@ -484,14 +484,14 @@ subroutine formResidual(residual_subdomain, F, &
DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: &
residual_subdomain !< DMDA info (needs to be named "in" for macros like XRANGE to work)
- real(pReal), dimension(3,3,cells(1),cells(2),cells3), intent(in) :: &
+ real(pREAL), dimension(3,3,cells(1),cells(2),cells3), intent(in) :: &
F !< deformation gradient field
- real(pReal), dimension(3,3,cells(1),cells(2),cells3), intent(out) :: &
+ real(pREAL), dimension(3,3,cells(1),cells(2),cells3), intent(out) :: &
r !< residuum field
PetscObject :: dummy
PetscErrorCode :: err_PETSc
- real(pReal), dimension(3,3) :: &
+ real(pREAL), dimension(3,3) :: &
deltaF_aim
PetscInt :: &
PETScIter, &
@@ -509,7 +509,7 @@ subroutine formResidual(residual_subdomain, F, &
newIteration: if (totalIter <= PETScIter) then
totalIter = totalIter + 1
print'(1x,a,3(a,i0))', trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter, '≤', num%itmax
- if (any(dNeq(params%rotation_BC%asQuaternion(), real([1.0, 0.0, 0.0, 0.0],pReal)))) &
+ if (any(dNeq(params%rotation_BC%asQuaternion(), real([1.0, 0.0, 0.0, 0.0],pREAL)))) &
print'(/,1x,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
'deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.))
print'(/,1x,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
@@ -528,7 +528,7 @@ subroutine formResidual(residual_subdomain, F, &
deltaF_aim = math_mul3333xx33(S, P_av - P_aim) ! S = 0.0 for no bc
F_aim = F_aim - deltaF_aim
- err_BC = maxval(abs(merge(.0_pReal,P_av - P_aim,params%stress_mask)))
+ err_BC = maxval(abs(merge(.0_pREAL,P_av - P_aim,params%stress_mask)))
r = utilities_GammaConvolution(r,params%rotation_BC%rotate(deltaF_aim,active=.true.))
diff --git a/src/grid/grid_mech_spectral_polarisation.f90 b/src/grid/grid_mech_spectral_polarisation.f90
index 7bdd84d25..0210d1036 100644
--- a/src/grid/grid_mech_spectral_polarisation.f90
+++ b/src/grid/grid_mech_spectral_polarisation.f90
@@ -40,14 +40,14 @@ module grid_mechanical_spectral_polarisation
integer :: &
itmin, & !< minimum number of iterations
itmax !< maximum number of iterations
- real(pReal) :: &
+ real(pREAL) :: &
eps_div_atol, & !< absolute tolerance for equilibrium
eps_div_rtol, & !< relative tolerance for equilibrium
eps_curl_atol, & !< absolute tolerance for compatibility
eps_curl_rtol, & !< relative tolerance for compatibility
eps_stress_atol, & !< absolute tolerance for fullfillment of stress BC
eps_stress_rtol !< relative tolerance for fullfillment of stress BC
- real(pReal) :: &
+ real(pREAL) :: &
alpha, & !< polarization scheme parameter 0.0 < alpha < 2.0. alpha = 1.0 ==> AL scheme, alpha = 2.0 ==> accelerated scheme
beta !< polarization scheme parameter 0.0 < beta < 2.0. beta = 1.0 ==> AL scheme, beta = 2.0 ==> accelerated scheme
end type tNumerics
@@ -62,7 +62,7 @@ module grid_mechanical_spectral_polarisation
!--------------------------------------------------------------------------------------------------
! common pointwise data
- real(pReal), dimension(:,:,:,:,:), allocatable :: &
+ real(pREAL), dimension(:,:,:,:,:), allocatable :: &
F_lastInc, & !< field of previous compatible deformation gradients
F_tau_lastInc, & !< field of previous incompatible deformation gradient
Fdot, & !< field of assumed rate of compatible deformation gradient
@@ -70,25 +70,25 @@ module grid_mechanical_spectral_polarisation
!--------------------------------------------------------------------------------------------------
! stress, stiffness and compliance average etc.
- real(pReal), dimension(3,3) :: &
- F_aimDot = 0.0_pReal, & !< assumed rate of average deformation gradient
+ real(pREAL), dimension(3,3) :: &
+ F_aimDot = 0.0_pREAL, & !< assumed rate of average deformation gradient
F_aim = math_I3, & !< current prescribed deformation gradient
F_aim_lastInc = math_I3, & !< previous average deformation gradient
- F_av = 0.0_pReal, & !< average incompatible def grad field
- P_av = 0.0_pReal, & !< average 1st Piola--Kirchhoff stress
- P_aim = 0.0_pReal
+ F_av = 0.0_pREAL, & !< average incompatible def grad field
+ P_av = 0.0_pREAL, & !< average 1st Piola--Kirchhoff stress
+ P_aim = 0.0_pREAL
character(len=:), allocatable :: incInfo !< time and increment information
- real(pReal), dimension(3,3,3,3) :: &
- C_volAvg = 0.0_pReal, & !< current volume average stiffness
- C_volAvgLastInc = 0.0_pReal, & !< previous volume average stiffness
- C_minMaxAvg = 0.0_pReal, & !< current (min+max)/2 stiffness
- C_minMaxAvgLastInc = 0.0_pReal, & !< previous (min+max)/2 stiffness
- C_minMaxAvgRestart = 0.0_pReal, & !< (min+max)/2 stiffnes (restart)
- S = 0.0_pReal, & !< current compliance (filled up with zeros)
- C_scale = 0.0_pReal, &
- S_scale = 0.0_pReal
+ real(pREAL), dimension(3,3,3,3) :: &
+ C_volAvg = 0.0_pREAL, & !< current volume average stiffness
+ C_volAvgLastInc = 0.0_pREAL, & !< previous volume average stiffness
+ C_minMaxAvg = 0.0_pREAL, & !< current (min+max)/2 stiffness
+ C_minMaxAvgLastInc = 0.0_pREAL, & !< previous (min+max)/2 stiffness
+ C_minMaxAvgRestart = 0.0_pREAL, & !< (min+max)/2 stiffnes (restart)
+ S = 0.0_pREAL, & !< current compliance (filled up with zeros)
+ C_scale = 0.0_pREAL, &
+ S_scale = 0.0_pREAL
- real(pReal) :: &
+ real(pREAL) :: &
err_BC, & !< deviation from stress BC
err_curl, & !< RMS of curl of F
err_div !< RMS of div of P
@@ -116,19 +116,19 @@ contains
!--------------------------------------------------------------------------------------------------
subroutine grid_mechanical_spectral_polarisation_init()
- real(pReal), dimension(3,3,cells(1),cells(2),cells3) :: P
+ real(pREAL), dimension(3,3,cells(1),cells(2),cells3) :: P
PetscErrorCode :: err_PETSc
integer(MPI_INTEGER_KIND) :: err_MPI
- real(pReal), pointer, dimension(:,:,:,:) :: &
+ real(pREAL), pointer, dimension(:,:,:,:) :: &
FandF_tau, & ! overall pointer to solution data
F, & ! specific (sub)pointer
F_tau ! specific (sub)pointer
PetscInt, dimension(0:worldsize-1) :: localK
- real(pReal), dimension(3,3,product(cells(1:2))*cells3) :: temp33n
+ real(pREAL), dimension(3,3,product(cells(1:2))*cells3) :: temp33n
integer(HID_T) :: fileHandle, groupHandle
type(tDict), pointer :: &
num_grid
- character(len=pStringLen) :: &
+ character(len=pSTRLEN) :: &
extmsg = ''
@@ -142,28 +142,28 @@ subroutine grid_mechanical_spectral_polarisation_init()
! read numerical parameters and do sanity checks
num_grid => config_numerics%get_dict('grid',defaultVal=emptyDict)
- num%update_gamma = num_grid%get_asBool ('update_gamma', defaultVal=.false.)
- num%eps_div_atol = num_grid%get_asFloat('eps_div_atol', defaultVal=1.0e-4_pReal)
- num%eps_div_rtol = num_grid%get_asFloat('eps_div_rtol', defaultVal=5.0e-4_pReal)
- num%eps_curl_atol = num_grid%get_asFloat('eps_curl_atol', defaultVal=1.0e-10_pReal)
- num%eps_curl_rtol = num_grid%get_asFloat('eps_curl_rtol', defaultVal=5.0e-4_pReal)
- num%eps_stress_atol = num_grid%get_asFloat('eps_stress_atol',defaultVal=1.0e3_pReal)
- num%eps_stress_rtol = num_grid%get_asFloat('eps_stress_rtol',defaultVal=1.0e-3_pReal)
- num%itmin = num_grid%get_asInt ('itmin', defaultVal=1)
- num%itmax = num_grid%get_asInt ('itmax', defaultVal=250)
- num%alpha = num_grid%get_asFloat('alpha', defaultVal=1.0_pReal)
- num%beta = num_grid%get_asFloat('beta', defaultVal=1.0_pReal)
+ num%update_gamma = num_grid%get_asBool('update_gamma', defaultVal=.false.)
+ num%eps_div_atol = num_grid%get_asReal('eps_div_atol', defaultVal=1.0e-4_pREAL)
+ num%eps_div_rtol = num_grid%get_asReal('eps_div_rtol', defaultVal=5.0e-4_pREAL)
+ num%eps_curl_atol = num_grid%get_asReal('eps_curl_atol', defaultVal=1.0e-10_pREAL)
+ num%eps_curl_rtol = num_grid%get_asReal('eps_curl_rtol', defaultVal=5.0e-4_pREAL)
+ num%eps_stress_atol = num_grid%get_asReal('eps_stress_atol',defaultVal=1.0e3_pREAL)
+ num%eps_stress_rtol = num_grid%get_asReal('eps_stress_rtol',defaultVal=1.0e-3_pREAL)
+ num%itmin = num_grid%get_asInt ('itmin', defaultVal=1)
+ num%itmax = num_grid%get_asInt ('itmax', defaultVal=250)
+ num%alpha = num_grid%get_asReal('alpha', defaultVal=1.0_pREAL)
+ num%beta = num_grid%get_asReal('beta', defaultVal=1.0_pREAL)
- if (num%eps_div_atol <= 0.0_pReal) extmsg = trim(extmsg)//' eps_div_atol'
- if (num%eps_div_rtol < 0.0_pReal) extmsg = trim(extmsg)//' eps_div_rtol'
- if (num%eps_curl_atol <= 0.0_pReal) extmsg = trim(extmsg)//' eps_curl_atol'
- if (num%eps_curl_rtol < 0.0_pReal) extmsg = trim(extmsg)//' eps_curl_rtol'
- if (num%eps_stress_atol <= 0.0_pReal) extmsg = trim(extmsg)//' eps_stress_atol'
- if (num%eps_stress_rtol < 0.0_pReal) extmsg = trim(extmsg)//' eps_stress_rtol'
+ if (num%eps_div_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_div_atol'
+ if (num%eps_div_rtol < 0.0_pREAL) extmsg = trim(extmsg)//' eps_div_rtol'
+ if (num%eps_curl_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_curl_atol'
+ if (num%eps_curl_rtol < 0.0_pREAL) extmsg = trim(extmsg)//' eps_curl_rtol'
+ if (num%eps_stress_atol <= 0.0_pREAL) extmsg = trim(extmsg)//' eps_stress_atol'
+ if (num%eps_stress_rtol < 0.0_pREAL) extmsg = trim(extmsg)//' eps_stress_rtol'
if (num%itmax <= 1) extmsg = trim(extmsg)//' itmax'
if (num%itmin > num%itmax .or. num%itmin < 1) extmsg = trim(extmsg)//' itmin'
- if (num%alpha <= 0.0_pReal .or. num%alpha > 2.0_pReal) extmsg = trim(extmsg)//' alpha'
- if (num%beta < 0.0_pReal .or. num%beta > 2.0_pReal) extmsg = trim(extmsg)//' beta'
+ if (num%alpha <= 0.0_pREAL .or. num%alpha > 2.0_pREAL) extmsg = trim(extmsg)//' alpha'
+ if (num%beta < 0.0_pREAL .or. num%beta > 2.0_pREAL) extmsg = trim(extmsg)//' beta'
if (extmsg /= '') call IO_error(301,ext_msg=trim(extmsg))
@@ -171,15 +171,15 @@ subroutine grid_mechanical_spectral_polarisation_init()
! set default and user defined options for PETSc
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-mechanical_snes_type ngmres',err_PETSc)
CHKERRQ(err_PETSc)
- call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asString('petsc_options',defaultVal=''),err_PETSc)
+ call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asStr('petsc_options',defaultVal=''),err_PETSc)
CHKERRQ(err_PETSc)
!--------------------------------------------------------------------------------------------------
! allocate global fields
- allocate(F_lastInc (3,3,cells(1),cells(2),cells3),source = 0.0_pReal)
- allocate(Fdot (3,3,cells(1),cells(2),cells3),source = 0.0_pReal)
- allocate(F_tau_lastInc(3,3,cells(1),cells(2),cells3),source = 0.0_pReal)
- allocate(F_tauDot (3,3,cells(1),cells(2),cells3),source = 0.0_pReal)
+ allocate(F_lastInc (3,3,cells(1),cells(2),cells3),source = 0.0_pREAL)
+ allocate(Fdot (3,3,cells(1),cells(2),cells3),source = 0.0_pREAL)
+ allocate(F_tau_lastInc(3,3,cells(1),cells(2),cells3),source = 0.0_pREAL)
+ allocate(F_tauDot (3,3,cells(1),cells(2),cells3),source = 0.0_pREAL)
!--------------------------------------------------------------------------------------------------
! initialize solver specific parts of PETSc
@@ -252,15 +252,15 @@ subroutine grid_mechanical_spectral_polarisation_init()
elseif (CLI_restartInc == 0) then restartRead
F_lastInc = spread(spread(spread(math_I3,3,cells(1)),4,cells(2)),5,cells3) ! initialize to identity
F = reshape(F_lastInc,[9,cells(1),cells(2),cells3])
- F_tau = 2.0_pReal*F
- F_tau_lastInc = 2.0_pReal*F_lastInc
+ F_tau = 2.0_pREAL*F
+ F_tau_lastInc = 2.0_pREAL*F_lastInc
end if restartRead
homogenization_F0 = reshape(F_lastInc, [3,3,product(cells(1:2))*cells3]) ! set starting condition for homogenization_mechanical_response
call utilities_updateCoords(reshape(F,shape(F_lastInc)))
call utilities_constitutiveResponse(P,P_av,C_volAvg,C_minMaxAvg, & ! stress field, stress avg, global average of stiffness and (min+max)/2
reshape(F,shape(F_lastInc)), & ! target F
- 0.0_pReal) ! time increment
+ 0.0_pREAL) ! time increment
call DMDAVecRestoreArrayF90(da,solution_vec,FandF_tau,err_PETSc) ! deassociate pointer
CHKERRQ(err_PETSc)
@@ -340,7 +340,7 @@ subroutine grid_mechanical_spectral_polarisation_forward(cutBack,guess,Delta_t,D
logical, intent(in) :: &
cutBack, &
guess
- real(pReal), intent(in) :: &
+ real(pREAL), intent(in) :: &
Delta_t_old, &
Delta_t, &
t_remaining !< remaining time of current load case
@@ -350,9 +350,9 @@ subroutine grid_mechanical_spectral_polarisation_forward(cutBack,guess,Delta_t,D
type(tRotation), intent(in) :: &
rotation_BC
PetscErrorCode :: err_PETSc
- real(pReal), pointer, dimension(:,:,:,:) :: FandF_tau, F, F_tau
+ real(pREAL), pointer, dimension(:,:,:,:) :: FandF_tau, F, F_tau
integer :: i, j, k
- real(pReal), dimension(3,3) :: F_lambda33
+ real(pREAL), dimension(3,3) :: F_lambda33
call DMDAVecGetArrayF90(da,solution_vec,FandF_tau,err_PETSc)
@@ -367,20 +367,20 @@ subroutine grid_mechanical_spectral_polarisation_forward(cutBack,guess,Delta_t,D
C_volAvgLastInc = C_volAvg
C_minMaxAvgLastInc = C_minMaxAvg
- F_aimDot = merge(merge(.0_pReal,(F_aim-F_aim_lastInc)/Delta_t_old,stress_BC%mask),.0_pReal,guess) ! estimate deformation rate for prescribed stress components
+ F_aimDot = merge(merge(.0_pREAL,(F_aim-F_aim_lastInc)/Delta_t_old,stress_BC%mask),.0_pREAL,guess) ! estimate deformation rate for prescribed stress components
F_aim_lastInc = F_aim
!-----------------------------------------------------------------------------------------------
! calculate rate for aim
if (deformation_BC%myType=='L') then ! calculate F_aimDot from given L and current F
F_aimDot = F_aimDot &
- + matmul(merge(.0_pReal,deformation_BC%values,deformation_BC%mask),F_aim_lastInc)
+ + matmul(merge(.0_pREAL,deformation_BC%values,deformation_BC%mask),F_aim_lastInc)
elseif (deformation_BC%myType=='dot_F') then ! F_aimDot is prescribed
F_aimDot = F_aimDot &
- + merge(.0_pReal,deformation_BC%values,deformation_BC%mask)
+ + merge(.0_pREAL,deformation_BC%values,deformation_BC%mask)
elseif (deformation_BC%myType=='F') then ! aim at end of load case is prescribed
F_aimDot = F_aimDot &
- + merge(.0_pReal,(deformation_BC%values - F_aim_lastInc)/t_remaining,deformation_BC%mask)
+ + merge(.0_pREAL,(deformation_BC%values - F_aim_lastInc)/t_remaining,deformation_BC%mask)
end if
Fdot = utilities_calculateRate(guess, &
@@ -399,9 +399,9 @@ subroutine grid_mechanical_spectral_polarisation_forward(cutBack,guess,Delta_t,D
! update average and local deformation gradients
F_aim = F_aim_lastInc + F_aimDot * Delta_t
if (stress_BC%myType=='P') P_aim = P_aim &
- + merge(.0_pReal,(stress_BC%values - P_aim)/t_remaining,stress_BC%mask)*Delta_t
+ + merge(.0_pREAL,(stress_BC%values - P_aim)/t_remaining,stress_BC%mask)*Delta_t
if (stress_BC%myType=='dot_P') P_aim = P_aim &
- + merge(.0_pReal,stress_BC%values,stress_BC%mask)*Delta_t
+ + merge(.0_pREAL,stress_BC%values,stress_BC%mask)*Delta_t
F = reshape(utilities_forwardField(Delta_t,F_lastInc,Fdot, & ! estimate of F at end of time+Delta_t that matches rotated F_aim on average
rotation_BC%rotate(F_aim,active=.true.)),&
@@ -413,7 +413,7 @@ subroutine grid_mechanical_spectral_polarisation_forward(cutBack,guess,Delta_t,D
do k = 1, cells3; do j = 1, cells(2); do i = 1, cells(1)
F_lambda33 = reshape(F_tau(1:9,i,j,k)-F(1:9,i,j,k),[3,3])
F_lambda33 = math_I3 &
- + math_mul3333xx33(S_scale,0.5_pReal*matmul(F_lambda33, &
+ + math_mul3333xx33(S_scale,0.5_pREAL*matmul(F_lambda33, &
math_mul3333xx33(C_scale,matmul(transpose(F_lambda33),F_lambda33)-math_I3)))
F_tau(1:9,i,j,k) = reshape(F_lambda33,[9])+F(1:9,i,j,k)
end do; end do; end do
@@ -437,7 +437,7 @@ end subroutine grid_mechanical_spectral_polarisation_forward
subroutine grid_mechanical_spectral_polarisation_updateCoords
PetscErrorCode :: err_PETSc
- real(pReal), dimension(:,:,:,:), pointer :: FandF_tau
+ real(pREAL), dimension(:,:,:,:), pointer :: FandF_tau
call DMDAVecGetArrayF90(da,solution_vec,FandF_tau,err_PETSc)
CHKERRQ(err_PETSc)
@@ -455,7 +455,7 @@ subroutine grid_mechanical_spectral_polarisation_restartWrite
PetscErrorCode :: err_PETSc
integer(HID_T) :: fileHandle, groupHandle
- real(pReal), dimension(:,:,:,:), pointer :: FandF_tau, F, F_tau
+ real(pREAL), dimension(:,:,:,:), pointer :: FandF_tau, F, F_tau
call DMDAVecGetArrayF90(da,solution_vec,FandF_tau,err_PETSc)
CHKERRQ(err_PETSc)
@@ -509,7 +509,7 @@ subroutine converged(snes_local,PETScIter,devNull1,devNull2,devNull3,reason,dumm
SNESConvergedReason :: reason
PetscObject :: dummy
PetscErrorCode :: err_PETSc
- real(pReal) :: &
+ real(pREAL) :: &
curlTol, &
divTol, &
BCTol
@@ -518,7 +518,7 @@ subroutine converged(snes_local,PETScIter,devNull1,devNull2,devNull3,reason,dumm
divTol = max(maxval(abs(P_av))*num%eps_div_rtol, num%eps_div_atol)
BCTol = max(maxval(abs(P_av))*num%eps_stress_rtol, num%eps_stress_atol)
- if ((totalIter >= num%itmin .and. all([err_div/divTol, err_curl/curlTol, err_BC/BCTol] < 1.0_pReal)) &
+ if ((totalIter >= num%itmin .and. all([err_div/divTol, err_curl/curlTol, err_BC/BCTol] < 1.0_pREAL)) &
.or. terminallyIll) then
reason = 1
elseif (totalIter >= num%itmax) then
@@ -548,14 +548,14 @@ subroutine formResidual(residual_subdomain, FandF_tau, &
r, dummy,err_PETSc)
DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: residual_subdomain !< DMDA info (needs to be named "in" for macros like XRANGE to work)
- real(pReal), dimension(3,3,2,cells(1),cells(2),cells3), target, intent(in) :: &
+ real(pREAL), dimension(3,3,2,cells(1),cells(2),cells3), target, intent(in) :: &
FandF_tau !< deformation gradient field
- real(pReal), dimension(3,3,2,cells(1),cells(2),cells3), target, intent(out) :: &
+ real(pREAL), dimension(3,3,2,cells(1),cells(2),cells3), target, intent(out) :: &
r !< residuum field
PetscObject :: dummy
PetscErrorCode :: err_PETSc
- real(pReal), pointer, dimension(:,:,:,:,:) :: &
+ real(pREAL), pointer, dimension(:,:,:,:,:) :: &
F, &
F_tau, &
r_F, &
@@ -587,7 +587,7 @@ subroutine formResidual(residual_subdomain, FandF_tau, &
newIteration: if (totalIter <= PETScIter) then
totalIter = totalIter + 1
print'(1x,a,3(a,i0))', trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter, '≤', num%itmax
- if (any(dNeq(params%rotation_BC%asQuaternion(), real([1.0, 0.0, 0.0, 0.0],pReal)))) &
+ if (any(dNeq(params%rotation_BC%asQuaternion(), real([1.0, 0.0, 0.0, 0.0],pREAL)))) &
print'(/,1x,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
'deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.))
print'(/,1x,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
diff --git a/src/grid/grid_thermal_spectral.f90 b/src/grid/grid_thermal_spectral.f90
index 6483c91c6..a0acbf822 100644
--- a/src/grid/grid_thermal_spectral.f90
+++ b/src/grid/grid_thermal_spectral.f90
@@ -35,7 +35,7 @@ module grid_thermal_spectral
type :: tNumerics
integer :: &
itmax !< maximum number of iterations
- real(pReal) :: &
+ real(pREAL) :: &
eps_thermal_atol, & !< absolute tolerance for thermal equilibrium
eps_thermal_rtol !< relative tolerance for thermal equilibrium
end type tNumerics
@@ -47,7 +47,7 @@ module grid_thermal_spectral
! PETSc data
SNES :: SNES_thermal
Vec :: solution_vec
- real(pReal), dimension(:,:,:), allocatable :: &
+ real(pREAL), dimension(:,:,:), allocatable :: &
T, & !< field of current temperature
T_lastInc, & !< field of previous temperature
T_stagInc, & !< field of staggered temperature
@@ -55,8 +55,8 @@ module grid_thermal_spectral
!--------------------------------------------------------------------------------------------------
! reference diffusion tensor, mobility etc.
integer :: totalIter = 0 !< total iteration in current increment
- real(pReal), dimension(3,3) :: K_ref
- real(pReal) :: mu_ref
+ real(pREAL), dimension(3,3) :: K_ref
+ real(pREAL) :: mu_ref
public :: &
grid_thermal_spectral_init, &
@@ -74,11 +74,11 @@ subroutine grid_thermal_spectral_init()
PetscInt, dimension(0:worldsize-1) :: localK
integer :: i, j, k, ce
DM :: thermal_grid
- real(pReal), dimension(:,:,:), pointer :: T_PETSc
+ real(pREAL), dimension(:,:,:), pointer :: T_PETSc
integer(MPI_INTEGER_KIND) :: err_MPI
PetscErrorCode :: err_PETSc
integer(HID_T) :: fileHandle, groupHandle
- real(pReal), dimension(1,product(cells(1:2))*cells3) :: tempN
+ real(pREAL), dimension(1,product(cells(1:2))*cells3) :: tempN
type(tDict), pointer :: &
num_grid
@@ -92,20 +92,20 @@ subroutine grid_thermal_spectral_init()
!-------------------------------------------------------------------------------------------------
! read numerical parameters and do sanity checks
num_grid => config_numerics%get_dict('grid',defaultVal=emptyDict)
- num%itmax = num_grid%get_asInt ('itmax', defaultVal=250)
- num%eps_thermal_atol = num_grid%get_asFloat ('eps_thermal_atol',defaultVal=1.0e-2_pReal)
- num%eps_thermal_rtol = num_grid%get_asFloat ('eps_thermal_rtol',defaultVal=1.0e-6_pReal)
+ num%itmax = num_grid%get_asInt ('itmax', defaultVal=250)
+ num%eps_thermal_atol = num_grid%get_asReal('eps_thermal_atol',defaultVal=1.0e-2_pREAL)
+ num%eps_thermal_rtol = num_grid%get_asReal('eps_thermal_rtol',defaultVal=1.0e-6_pREAL)
if (num%itmax <= 1) call IO_error(301,ext_msg='itmax')
- if (num%eps_thermal_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_thermal_atol')
- if (num%eps_thermal_rtol <= 0.0_pReal) call IO_error(301,ext_msg='eps_thermal_rtol')
+ if (num%eps_thermal_atol <= 0.0_pREAL) call IO_error(301,ext_msg='eps_thermal_atol')
+ if (num%eps_thermal_rtol <= 0.0_pREAL) call IO_error(301,ext_msg='eps_thermal_rtol')
!--------------------------------------------------------------------------------------------------
! set default and user defined options for PETSc
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-thermal_snes_type newtonls -thermal_snes_mf &
&-thermal_snes_ksp_ew -thermal_ksp_type fgmres',err_PETSc)
CHKERRQ(err_PETSc)
- call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asString('petsc_options',defaultVal=''),err_PETSc)
+ call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_grid%get_asStr('petsc_options',defaultVal=''),err_PETSc)
CHKERRQ(err_PETSc)
!--------------------------------------------------------------------------------------------------
@@ -113,7 +113,7 @@ subroutine grid_thermal_spectral_init()
T = discretization_grid_getInitialCondition('T')
T_lastInc = T
T_stagInc = T
- dotT_lastInc = 0.0_pReal * T
+ dotT_lastInc = 0.0_pREAL * T
!--------------------------------------------------------------------------------------------------
! initialize solver specific parts of PETSc
@@ -165,7 +165,7 @@ subroutine grid_thermal_spectral_init()
ce = 0
do k = 1, cells3; do j = 1, cells(2); do i = 1, cells(1)
ce = ce + 1
- call homogenization_thermal_setField(T(i,j,k),0.0_pReal,ce)
+ call homogenization_thermal_setField(T(i,j,k),0.0_pREAL,ce)
end do; end do; end do
call DMDAVecGetArrayF90(thermal_grid,solution_vec,T_PETSc,err_PETSc)
@@ -184,7 +184,7 @@ end subroutine grid_thermal_spectral_init
!--------------------------------------------------------------------------------------------------
function grid_thermal_spectral_solution(Delta_t) result(solution)
- real(pReal), intent(in) :: &
+ real(pREAL), intent(in) :: &
Delta_t !< increment in time for current solution
integer :: i, j, k, ce
type(tSolutionState) :: solution
@@ -251,7 +251,7 @@ subroutine grid_thermal_spectral_forward(cutBack)
integer :: i, j, k, ce
DM :: dm_local
- real(pReal), dimension(:,:,:), pointer :: T_PETSc
+ real(pREAL), dimension(:,:,:), pointer :: T_PETSc
PetscErrorCode :: err_PETSc
@@ -290,7 +290,7 @@ subroutine grid_thermal_spectral_restartWrite
PetscErrorCode :: err_PETSc
DM :: dm_local
integer(HID_T) :: fileHandle, groupHandle
- real(pReal), dimension(:,:,:), pointer :: T
+ real(pREAL), dimension(:,:,:), pointer :: T
call SNESGetDM(SNES_thermal,dm_local,err_PETSc);
CHKERRQ(err_PETSc)
@@ -321,15 +321,15 @@ subroutine formResidual(residual_subdomain,x_scal,r,dummy,err_PETSc)
DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: &
residual_subdomain
- real(pReal), dimension(cells(1),cells(2),cells3), intent(in) :: &
+ real(pREAL), dimension(cells(1),cells(2),cells3), intent(in) :: &
x_scal
- real(pReal), dimension(cells(1),cells(2),cells3), intent(out) :: &
+ real(pREAL), dimension(cells(1),cells(2),cells3), intent(out) :: &
r !< residual
PetscObject :: dummy
PetscErrorCode, intent(out) :: err_PETSc
integer :: i, j, k, ce
- real(pReal), dimension(3,cells(1),cells(2),cells3) :: vectorField
+ real(pREAL), dimension(3,cells(1),cells(2),cells3) :: vectorField
T = x_scal
@@ -364,8 +364,8 @@ subroutine updateReference()
integer(MPI_INTEGER_KIND) :: err_MPI
- K_ref = 0.0_pReal
- mu_ref = 0.0_pReal
+ K_ref = 0.0_pREAL
+ mu_ref = 0.0_pREAL
do ce = 1, product(cells(1:2))*cells3
K_ref = K_ref + homogenization_K_T(ce)
mu_ref = mu_ref + homogenization_mu_T(ce)
diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90
index 5821bd3c0..5f82b5a8f 100644
--- a/src/grid/spectral_utilities.f90
+++ b/src/grid/spectral_utilities.f90
@@ -32,8 +32,8 @@ module spectral_utilities
!--------------------------------------------------------------------------------------------------
! grid related information
- real(pReal), protected, public :: wgt !< weighting factor 1/Nelems
- real(pReal), protected, public, dimension(3) :: scaledGeomSize !< scaled geometry size for calculation of divergence
+ real(pREAL), protected, public :: wgt !< weighting factor 1/Nelems
+ real(pREAL), protected, public, dimension(3) :: scaledGeomSize !< scaled geometry size for calculation of divergence
integer :: &
cells1Red, & !< cells(1)/2+1
cells2, & !< (local) cells in 2nd direction
@@ -48,10 +48,10 @@ module spectral_utilities
complex(C_DOUBLE_COMPLEX), dimension(:,:,:,:,:), pointer :: tensorField_fourier !< tensor field in Fourier space
complex(C_DOUBLE_COMPLEX), dimension(:,:,:,:), pointer :: vectorField_fourier !< vector field in Fourier space
complex(C_DOUBLE_COMPLEX), dimension(:,:,:), pointer :: scalarField_fourier !< scalar field in Fourier space
- complex(pReal), dimension(:,:,:,:,:,:,:), allocatable :: gamma_hat !< gamma operator (field) for spectral method
- complex(pReal), dimension(:,:,:,:), allocatable :: xi1st !< wave vector field for first derivatives
- complex(pReal), dimension(:,:,:,:), allocatable :: xi2nd !< wave vector field for second derivatives
- real(pReal), dimension(3,3,3,3) :: C_ref !< mechanic reference stiffness
+ complex(pREAL), dimension(:,:,:,:,:,:,:), allocatable :: gamma_hat !< gamma operator (field) for spectral method
+ complex(pREAL), dimension(:,:,:,:), allocatable :: xi1st !< wave vector field for first derivatives
+ complex(pREAL), dimension(:,:,:,:), allocatable :: xi2nd !< wave vector field for second derivatives
+ real(pREAL), dimension(3,3,3,3) :: C_ref !< mechanic reference stiffness
!--------------------------------------------------------------------------------------------------
@@ -76,16 +76,16 @@ module spectral_utilities
end type tSolutionState
type, public :: tBoundaryCondition !< set of parameters defining a boundary condition
- real(pReal), dimension(3,3) :: values = 0.0_pReal
+ real(pREAL), dimension(3,3) :: values = 0.0_pREAL
logical, dimension(3,3) :: mask = .true.
character(len=:), allocatable :: myType
end type tBoundaryCondition
type, public :: tSolutionParams
- real(pReal), dimension(3,3) :: stress_BC
+ real(pREAL), dimension(3,3) :: stress_BC
logical, dimension(3,3) :: stress_mask
type(tRotation) :: rotation_BC
- real(pReal) :: Delta_t
+ real(pREAL) :: Delta_t
end type tSolutionParams
type :: tNumerics
@@ -168,11 +168,11 @@ subroutine spectral_utilities_init()
call PetscOptionsClear(PETSC_NULL_OPTIONS,err_PETSc)
CHKERRQ(err_PETSc)
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,&
- num_grid%get_asString('PETSc_options',defaultVal=''),err_PETSc)
+ num_grid%get_asStr('PETSc_options',defaultVal=''),err_PETSc)
CHKERRQ(err_PETSc)
cells1Red = cells(1)/2 + 1
- wgt = real(product(cells),pReal)**(-1)
+ wgt = real(product(cells),pREAL)**(-1)
num%memory_efficient = num_grid%get_asInt('memory_efficient', defaultVal=1) > 0 ! ToDo: should be logical in YAML file
num%divergence_correction = num_grid%get_asInt('divergence_correction', defaultVal=2)
@@ -180,7 +180,7 @@ subroutine spectral_utilities_init()
if (num%divergence_correction < 0 .or. num%divergence_correction > 2) &
call IO_error(301,ext_msg='divergence_correction')
- select case (num_grid%get_asString('derivative',defaultVal='continuous'))
+ select case (num_grid%get_asStr('derivative',defaultVal='continuous'))
case ('continuous')
spectral_derivative_ID = DERIVATIVE_CONTINUOUS_ID
case ('central_difference')
@@ -188,7 +188,7 @@ subroutine spectral_utilities_init()
case ('FWBW_difference')
spectral_derivative_ID = DERIVATIVE_FWBW_DIFF_ID
case default
- call IO_error(892,ext_msg=trim(num_grid%get_asString('derivative')))
+ call IO_error(892,ext_msg=trim(num_grid%get_asStr('derivative')))
end select
!--------------------------------------------------------------------------------------------------
@@ -201,15 +201,15 @@ subroutine spectral_utilities_init()
end do
elseif (num%divergence_correction == 2) then
do j = 1, 3
- if ( j /= int(minloc(geomSize/real(cells,pReal),1)) &
- .and. j /= int(maxloc(geomSize/real(cells,pReal),1))) &
- scaledGeomSize = geomSize/geomSize(j)*real(cells(j),pReal)
+ if ( j /= int(minloc(geomSize/real(cells,pREAL),1)) &
+ .and. j /= int(maxloc(geomSize/real(cells,pREAL),1))) &
+ scaledGeomSize = geomSize/geomSize(j)*real(cells(j),pREAL)
end do
else
scaledGeomSize = geomSize
end if
- select case(IO_lc(num_grid%get_asString('fftw_plan_mode',defaultVal='FFTW_MEASURE')))
+ select case(IO_lc(num_grid%get_asStr('fftw_plan_mode',defaultVal='FFTW_MEASURE')))
case('fftw_estimate') ! ordered from slow execution (but fast plan creation) to fast execution
FFTW_planner_flag = FFTW_ESTIMATE
case('fftw_measure')
@@ -219,14 +219,14 @@ subroutine spectral_utilities_init()
case('fftw_exhaustive')
FFTW_planner_flag = FFTW_EXHAUSTIVE
case default
- call IO_warning(47,'using default FFTW_MEASURE instead of "'//trim(num_grid%get_asString('fftw_plan_mode'))//'"')
+ call IO_warning(47,'using default FFTW_MEASURE instead of "'//trim(num_grid%get_asStr('fftw_plan_mode'))//'"')
FFTW_planner_flag = FFTW_MEASURE
end select
!--------------------------------------------------------------------------------------------------
! general initialization of FFTW (see manual on fftw.org for more details)
- if (pReal /= C_DOUBLE .or. kind(1) /= C_INT) error stop 'C and Fortran datatypes do not match'
- call fftw_set_timelimit(num_grid%get_asFloat('fftw_timelimit',defaultVal=300.0_pReal))
+ if (pREAL /= C_DOUBLE .or. kind(1) /= C_INT) error stop 'C and Fortran datatypes do not match'
+ call fftw_set_timelimit(num_grid%get_asReal('fftw_timelimit',defaultVal=300.0_pREAL))
print'(/,1x,a)', 'FFTW initialized'; flush(IO_STDOUT)
@@ -268,8 +268,8 @@ subroutine spectral_utilities_init()
!--------------------------------------------------------------------------------------------------
! allocation
- allocate (xi1st (3,cells1Red,cells(3),cells2),source = cmplx(0.0_pReal,0.0_pReal,pReal)) ! frequencies for first derivatives, only half the size for first dimension
- allocate (xi2nd (3,cells1Red,cells(3),cells2),source = cmplx(0.0_pReal,0.0_pReal,pReal)) ! frequencies for second derivatives, only half the size for first dimension
+ allocate (xi1st (3,cells1Red,cells(3),cells2),source = cmplx(0.0_pREAL,0.0_pREAL,pREAL)) ! frequencies for first derivatives, only half the size for first dimension
+ allocate (xi2nd (3,cells1Red,cells(3),cells2),source = cmplx(0.0_pREAL,0.0_pREAL,pREAL)) ! frequencies for second derivatives, only half the size for first dimension
!--------------------------------------------------------------------------------------------------
! tensor MPI fftw plans
@@ -321,16 +321,16 @@ subroutine spectral_utilities_init()
xi2nd(1:3,i,k,j-cells2Offset) = utilities_getFreqDerivative(k_s)
where(mod(cells,2)==0 .and. [i,j,k] == cells/2+1 .and. &
spectral_derivative_ID == DERIVATIVE_CONTINUOUS_ID) ! for even grids, set the Nyquist Freq component to 0.0
- xi1st(1:3,i,k,j-cells2Offset) = cmplx(0.0_pReal,0.0_pReal,pReal)
+ xi1st(1:3,i,k,j-cells2Offset) = cmplx(0.0_pREAL,0.0_pREAL,pREAL)
elsewhere
xi1st(1:3,i,k,j-cells2Offset) = xi2nd(1:3,i,k,j-cells2Offset)
endwhere
end do; end do; end do
if (num%memory_efficient) then ! allocate just single fourth order tensor
- allocate (gamma_hat(3,3,3,3,1,1,1), source = cmplx(0.0_pReal,0.0_pReal,pReal))
+ allocate (gamma_hat(3,3,3,3,1,1,1), source = cmplx(0.0_pREAL,0.0_pREAL,pREAL))
else ! precalculation of gamma_hat field
- allocate (gamma_hat(3,3,3,3,cells1Red,cells(3),cells2), source = cmplx(0.0_pReal,0.0_pReal,pReal))
+ allocate (gamma_hat(3,3,3,3,cells1Red,cells(3),cells2), source = cmplx(0.0_pREAL,0.0_pREAL,pREAL))
end if
call selfTest()
@@ -346,10 +346,10 @@ end subroutine spectral_utilities_init
!---------------------------------------------------------------------------------------------------
subroutine utilities_updateGamma(C)
- real(pReal), intent(in), dimension(3,3,3,3) :: C !< input stiffness to store as reference stiffness
+ real(pREAL), intent(in), dimension(3,3,3,3) :: C !< input stiffness to store as reference stiffness
- complex(pReal), dimension(3,3) :: temp33_cmplx, xiDyad_cmplx
- real(pReal), dimension(6,6) :: A, A_inv
+ complex(pREAL), dimension(3,3) :: temp33_cmplx, xiDyad_cmplx
+ real(pREAL), dimension(6,6) :: A, A_inv
integer :: &
i, j, k, &
l, m, n, o
@@ -359,7 +359,7 @@ subroutine utilities_updateGamma(C)
C_ref = C/wgt
if (.not. num%memory_efficient) then
- gamma_hat = cmplx(0.0_pReal,0.0_pReal,pReal) ! for the singular point and any non invertible A
+ gamma_hat = cmplx(0.0_pREAL,0.0_pREAL,pREAL) ! for the singular point and any non invertible A
!$OMP PARALLEL DO PRIVATE(l,m,n,o,temp33_cmplx,xiDyad_cmplx,A,A_inv,err)
do j = cells2Offset+1, cells2Offset+cells2; do k = 1, cells(3); do i = 1, cells1Red
if (any([i,j,k] /= 1)) then ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1
@@ -368,19 +368,19 @@ subroutine utilities_updateGamma(C)
xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,k,j-cells2Offset))*xi1st(m,i,k,j-cells2Offset)
end do
do concurrent(l = 1:3, m = 1:3)
- temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal,pReal)*xiDyad_cmplx)
+ temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pREAL,pREAL)*xiDyad_cmplx)
end do
#else
forall(l = 1:3, m = 1:3) &
xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,k,j-cells2Offset))*xi1st(m,i,k,j-cells2Offset)
forall(l = 1:3, m = 1:3) &
- temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal,pReal)*xiDyad_cmplx)
+ temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pREAL,pREAL)*xiDyad_cmplx)
#endif
A(1:3,1:3) = temp33_cmplx%re; A(4:6,4:6) = temp33_cmplx%re
A(1:3,4:6) = temp33_cmplx%im; A(4:6,1:3) = -temp33_cmplx%im
- if (abs(math_det33(A(1:3,1:3))) > 1.e-16_pReal) then
+ if (abs(math_det33(A(1:3,1:3))) > 1.e-16_pREAL) then
call math_invert(A_inv, err, A)
- temp33_cmplx = cmplx(A_inv(1:3,1:3),A_inv(1:3,4:6),pReal)
+ temp33_cmplx = cmplx(A_inv(1:3,1:3),A_inv(1:3,4:6),pREAL)
#ifndef __INTEL_COMPILER
do concurrent(l=1:3, m=1:3, n=1:3, o=1:3)
gamma_hat(l,m,n,o,i,k,j-cells2Offset) = temp33_cmplx(l,n) * xiDyad_cmplx(o,m)
@@ -404,12 +404,12 @@ end subroutine utilities_updateGamma
!--------------------------------------------------------------------------------------------------
function utilities_GammaConvolution(field, fieldAim) result(gammaField)
- real(pReal), intent(in), dimension(3,3,cells(1),cells(2),cells3) :: field
- real(pReal), intent(in), dimension(3,3) :: fieldAim !< desired average value of the field after convolution
- real(pReal), dimension(3,3,cells(1),cells(2),cells3) :: gammaField
+ real(pREAL), intent(in), dimension(3,3,cells(1),cells(2),cells3) :: field
+ real(pREAL), intent(in), dimension(3,3) :: fieldAim !< desired average value of the field after convolution
+ real(pREAL), dimension(3,3,cells(1),cells(2),cells3) :: gammaField
- complex(pReal), dimension(3,3) :: temp33_cmplx, xiDyad_cmplx
- real(pReal), dimension(6,6) :: A, A_inv
+ complex(pREAL), dimension(3,3) :: temp33_cmplx, xiDyad_cmplx
+ real(pREAL), dimension(6,6) :: A, A_inv
integer :: &
i, j, k, &
l, m, n, o
@@ -419,7 +419,7 @@ function utilities_GammaConvolution(field, fieldAim) result(gammaField)
print'(/,1x,a)', '... doing gamma convolution ...............................................'
flush(IO_STDOUT)
- tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pReal
+ tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pREAL
tensorField_real(1:3,1:3,1:cells(1), 1:cells(2),1:cells3) = field
call fftw_mpi_execute_dft_r2c(planTensorForth,tensorField_real,tensorField_fourier)
@@ -432,19 +432,19 @@ function utilities_GammaConvolution(field, fieldAim) result(gammaField)
xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,k,j))*xi1st(m,i,k,j)
end do
do concurrent(l = 1:3, m = 1:3)
- temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal,pReal)*xiDyad_cmplx)
+ temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pREAL,pREAL)*xiDyad_cmplx)
end do
#else
forall(l = 1:3, m = 1:3) &
xiDyad_cmplx(l,m) = conjg(-xi1st(l,i,k,j))*xi1st(m,i,k,j)
forall(l = 1:3, m = 1:3) &
- temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pReal,pReal)*xiDyad_cmplx)
+ temp33_cmplx(l,m) = sum(cmplx(C_ref(l,1:3,m,1:3),0.0_pREAL,pREAL)*xiDyad_cmplx)
#endif
A(1:3,1:3) = temp33_cmplx%re; A(4:6,4:6) = temp33_cmplx%re
A(1:3,4:6) = temp33_cmplx%im; A(4:6,1:3) = -temp33_cmplx%im
- if (abs(math_det33(A(1:3,1:3))) > 1.e-16_pReal) then
+ if (abs(math_det33(A(1:3,1:3))) > 1.e-16_pREAL) then
call math_invert(A_inv, err, A)
- temp33_cmplx = cmplx(A_inv(1:3,1:3),A_inv(1:3,4:6),pReal)
+ temp33_cmplx = cmplx(A_inv(1:3,1:3),A_inv(1:3,4:6),pREAL)
#ifndef __INTEL_COMPILER
do concurrent(l=1:3, m=1:3, n=1:3, o=1:3)
gamma_hat(l,m,n,o,1,1,1) = temp33_cmplx(l,n)*xiDyad_cmplx(o,m)
@@ -460,7 +460,7 @@ function utilities_GammaConvolution(field, fieldAim) result(gammaField)
#endif
tensorField_fourier(1:3,1:3,i,k,j) = temp33_cmplx
else
- tensorField_fourier(1:3,1:3,i,k,j) = cmplx(0.0_pReal,0.0_pReal,pReal)
+ tensorField_fourier(1:3,1:3,i,k,j) = cmplx(0.0_pREAL,0.0_pREAL,pREAL)
end if
end if
end do; end do; end do
@@ -481,7 +481,7 @@ function utilities_GammaConvolution(field, fieldAim) result(gammaField)
!$OMP END PARALLEL DO
end if memoryEfficient
- if (cells3Offset == 0) tensorField_fourier(1:3,1:3,1,1,1) = cmplx(fieldAim,0.0_pReal,pReal)
+ if (cells3Offset == 0) tensorField_fourier(1:3,1:3,1,1,1) = cmplx(fieldAim,0.0_pREAL,pREAL)
call fftw_mpi_execute_dft_c2r(planTensorBack,tensorField_fourier,tensorField_real)
gammaField = tensorField_real(1:3,1:3,1:cells(1),1:cells(2),1:cells3)
@@ -494,24 +494,24 @@ end function utilities_GammaConvolution
!--------------------------------------------------------------------------------------------------
function utilities_GreenConvolution(field, D_ref, mu_ref, Delta_t) result(greenField)
- real(pReal), intent(in), dimension(cells(1),cells(2),cells3) :: field
- real(pReal), dimension(3,3), intent(in) :: D_ref
- real(pReal), intent(in) :: mu_ref, Delta_t
- real(pReal), dimension(cells(1),cells(2),cells3) :: greenField
+ real(pREAL), intent(in), dimension(cells(1),cells(2),cells3) :: field
+ real(pREAL), dimension(3,3), intent(in) :: D_ref
+ real(pREAL), intent(in) :: mu_ref, Delta_t
+ real(pREAL), dimension(cells(1),cells(2),cells3) :: greenField
- complex(pReal) :: GreenOp_hat
+ complex(pREAL) :: GreenOp_hat
integer :: i, j, k
- scalarField_real(cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pReal
+ scalarField_real(cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pREAL
scalarField_real(1:cells(1), 1:cells(2),1:cells3) = field
call fftw_mpi_execute_dft_r2c(planScalarForth,scalarField_real,scalarField_fourier)
!$OMP PARALLEL DO PRIVATE(GreenOp_hat)
do j = 1, cells2; do k = 1, cells(3); do i = 1, cells1Red
- GreenOp_hat = cmplx(wgt,0.0_pReal,pReal) &
- / (cmplx(mu_ref,0.0_pReal,pReal) + cmplx(Delta_t,0.0_pReal,pReal) &
- * sum(conjg(xi1st(1:3,i,k,j))* matmul(cmplx(D_ref,0.0_pReal,pReal),xi1st(1:3,i,k,j))))
+ GreenOp_hat = cmplx(wgt,0.0_pREAL,pREAL) &
+ / (cmplx(mu_ref,0.0_pREAL,pREAL) + cmplx(Delta_t,0.0_pREAL,pREAL) &
+ * sum(conjg(xi1st(1:3,i,k,j))* matmul(cmplx(D_ref,0.0_pREAL,pREAL),xi1st(1:3,i,k,j))))
scalarField_fourier(i,k,j) = scalarField_fourier(i,k,j)*GreenOp_hat
end do; end do; end do
!$OMP END PARALLEL DO
@@ -525,28 +525,28 @@ end function utilities_GreenConvolution
!--------------------------------------------------------------------------------------------------
!> @brief Calculate root mean square of divergence.
!--------------------------------------------------------------------------------------------------
-real(pReal) function utilities_divergenceRMS(tensorField)
+real(pREAL) function utilities_divergenceRMS(tensorField)
- real(pReal), dimension(3,3,cells(1),cells(2),cells3), intent(in) :: tensorField
+ real(pREAL), dimension(3,3,cells(1),cells(2),cells3), intent(in) :: tensorField
integer :: i, j, k
integer(MPI_INTEGER_KIND) :: err_MPI
- complex(pReal), dimension(3) :: rescaledGeom
+ complex(pREAL), dimension(3) :: rescaledGeom
- tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pReal
+ tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pREAL
tensorField_real(1:3,1:3,1:cells(1), 1:cells(2),1:cells3) = tensorField
call fftw_mpi_execute_dft_r2c(planTensorForth,tensorField_real,tensorField_fourier)
- rescaledGeom = cmplx(geomSize/scaledGeomSize,0.0_pReal,pReal)
+ rescaledGeom = cmplx(geomSize/scaledGeomSize,0.0_pREAL,pREAL)
!--------------------------------------------------------------------------------------------------
! calculating RMS divergence criterion in Fourier space
- utilities_divergenceRMS = 0.0_pReal
+ utilities_divergenceRMS = 0.0_pREAL
do j = 1, cells2; do k = 1, cells(3)
do i = 2, cells1Red -1 ! Has somewhere a conj. complex counterpart. Therefore count it twice.
utilities_divergenceRMS = utilities_divergenceRMS &
- + 2.0_pReal*(sum (real(matmul(tensorField_fourier(1:3,1:3,i,k,j), & ! (sqrt(real(a)**2 + aimag(a)**2))**2 = real(a)**2 + aimag(a)**2, i.e. do not take square root and square again
+ + 2.0_pREAL*(sum (real(matmul(tensorField_fourier(1:3,1:3,i,k,j), & ! (sqrt(real(a)**2 + aimag(a)**2))**2 = real(a)**2 + aimag(a)**2, i.e. do not take square root and square again
conjg(-xi1st(1:3,i,k,j))*rescaledGeom))**2) & ! --> sum squared L_2 norm of vector
+sum(aimag(matmul(tensorField_fourier(1:3,1:3,i,k,j),&
conjg(-xi1st(1:3,i,k,j))*rescaledGeom))**2))
@@ -564,7 +564,7 @@ real(pReal) function utilities_divergenceRMS(tensorField)
call MPI_Allreduce(MPI_IN_PLACE,utilities_divergenceRMS,1_MPI_INTEGER_KIND,MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
utilities_divergenceRMS = sqrt(utilities_divergenceRMS) * wgt ! RMS in real space calculated with Parsevals theorem from Fourier space
- if (cells(1) == 1) utilities_divergenceRMS = utilities_divergenceRMS * 0.5_pReal ! counted twice in case of cells(1) == 1
+ if (cells(1) == 1) utilities_divergenceRMS = utilities_divergenceRMS * 0.5_pREAL ! counted twice in case of cells(1) == 1
end function utilities_divergenceRMS
@@ -572,25 +572,25 @@ end function utilities_divergenceRMS
!--------------------------------------------------------------------------------------------------
!> @brief Calculate root mean square of curl.
!--------------------------------------------------------------------------------------------------
-real(pReal) function utilities_curlRMS(tensorField)
+real(pREAL) function utilities_curlRMS(tensorField)
- real(pReal), dimension(3,3,cells(1),cells(2),cells3), intent(in) :: tensorField
+ real(pREAL), dimension(3,3,cells(1),cells(2),cells3), intent(in) :: tensorField
integer :: i, j, k, l
integer(MPI_INTEGER_KIND) :: err_MPI
- complex(pReal), dimension(3,3) :: curl_fourier
- complex(pReal), dimension(3) :: rescaledGeom
+ complex(pREAL), dimension(3,3) :: curl_fourier
+ complex(pREAL), dimension(3) :: rescaledGeom
- tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pReal
+ tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pREAL
tensorField_real(1:3,1:3,1:cells(1), 1:cells(2),1:cells3) = tensorField
call fftw_mpi_execute_dft_r2c(planTensorForth,tensorField_real,tensorField_fourier)
- rescaledGeom = cmplx(geomSize/scaledGeomSize,0.0_pReal,pReal)
+ rescaledGeom = cmplx(geomSize/scaledGeomSize,0.0_pREAL,pREAL)
!--------------------------------------------------------------------------------------------------
! calculating max curl criterion in Fourier space
- utilities_curlRMS = 0.0_pReal
+ utilities_curlRMS = 0.0_pREAL
do j = 1, cells2; do k = 1, cells(3);
do i = 2, cells1Red - 1
@@ -603,7 +603,7 @@ real(pReal) function utilities_curlRMS(tensorField)
-tensorField_fourier(l,1,i,k,j)*xi1st(2,i,k,j)*rescaledGeom(2))
end do
utilities_curlRMS = utilities_curlRMS &
- +2.0_pReal*sum(curl_fourier%re**2+curl_fourier%im**2) ! Has somewhere a conj. complex counterpart. Therefore count it twice.
+ +2.0_pREAL*sum(curl_fourier%re**2+curl_fourier%im**2) ! Has somewhere a conj. complex counterpart. Therefore count it twice.
end do
do l = 1, 3
curl_fourier = (+tensorField_fourier(l,3,1,k,j)*xi1st(2,1,k,j)*rescaledGeom(2) &
@@ -630,7 +630,7 @@ real(pReal) function utilities_curlRMS(tensorField)
call MPI_Allreduce(MPI_IN_PLACE,utilities_curlRMS,1_MPI_INTEGER_KIND,MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
utilities_curlRMS = sqrt(utilities_curlRMS) * wgt ! RMS in real space calculated with Parsevals theorem from Fourier space
- if (cells(1) == 1) utilities_curlRMS = utilities_curlRMS * 0.5_pReal ! counted twice in case of cells(1) == 1
+ if (cells(1) == 1) utilities_curlRMS = utilities_curlRMS * 0.5_pREAL ! counted twice in case of cells(1) == 1
end function utilities_curlRMS
@@ -640,22 +640,22 @@ end function utilities_curlRMS
!--------------------------------------------------------------------------------------------------
function utilities_maskedCompliance(rot_BC,mask_stress,C)
- real(pReal), dimension(3,3,3,3) :: utilities_maskedCompliance !< masked compliance
- real(pReal), intent(in), dimension(3,3,3,3) :: C !< current average stiffness
+ real(pREAL), dimension(3,3,3,3) :: utilities_maskedCompliance !< masked compliance
+ real(pREAL), intent(in), dimension(3,3,3,3) :: C !< current average stiffness
type(tRotation), intent(in) :: rot_BC !< rotation of load frame
logical, intent(in), dimension(3,3) :: mask_stress !< mask of stress BC
integer :: i, j
logical, dimension(9) :: mask_stressVector
logical, dimension(9,9) :: mask
- real(pReal), dimension(9,9) :: temp99_real
+ real(pREAL), dimension(9,9) :: temp99_real
integer :: size_reduced = 0
- real(pReal), dimension(:,:), allocatable :: &
+ real(pREAL), dimension(:,:), allocatable :: &
s_reduced, & !< reduced compliance matrix (depending on number of stress BC)
c_reduced, & !< reduced stiffness (depending on number of stress BC)
sTimesC !< temp variable to check inversion
logical :: errmatinv
- character(len=pStringLen):: formatString
+ character(len=pSTRLEN):: formatString
mask_stressVector = .not. reshape(transpose(mask_stress), [9])
size_reduced = count(mask_stressVector)
@@ -674,7 +674,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
!--------------------------------------------------------------------------------------------------
! check if inversion was successful
sTimesC = matmul(c_reduced,s_reduced)
- errmatinv = errmatinv .or. any(dNeq(sTimesC,math_eye(size_reduced),1.0e-12_pReal))
+ errmatinv = errmatinv .or. any(dNeq(sTimesC,math_eye(size_reduced),1.0e-12_pREAL))
if (errmatinv) then
write(formatString, '(i2)') size_reduced
formatString = '(/,1x,a,/,'//trim(formatString)//'('//trim(formatString)//'(2x,es9.2,1x)/))'
@@ -682,9 +682,9 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
print trim(formatString), 'S (load) ', transpose(s_reduced)
if (errmatinv) error stop 'matrix inversion error'
end if
- temp99_real = reshape(unpack(reshape(s_reduced,[size_reduced**2]),reshape(mask,[81]),0.0_pReal),[9,9])
+ temp99_real = reshape(unpack(reshape(s_reduced,[size_reduced**2]),reshape(mask,[81]),0.0_pREAL),[9,9])
else
- temp99_real = 0.0_pReal
+ temp99_real = 0.0_pREAL
end if
utilities_maskedCompliance = math_99to3333(temp99_Real)
@@ -697,13 +697,13 @@ end function utilities_maskedCompliance
!--------------------------------------------------------------------------------------------------
function utilities_scalarGradient(field) result(grad)
- real(pReal), intent(in), dimension( cells(1),cells(2),cells3) :: field
- real(pReal), dimension(3,cells(1),cells(2),cells3) :: grad
+ real(pREAL), intent(in), dimension( cells(1),cells(2),cells3) :: field
+ real(pREAL), dimension(3,cells(1),cells(2),cells3) :: grad
integer :: i, j, k
- scalarField_real(cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pReal
+ scalarField_real(cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pREAL
scalarField_real(1:cells(1), 1:cells(2),1:cells3) = field
call fftw_mpi_execute_dft_r2c(planScalarForth,scalarField_real,scalarField_fourier)
do j = 1, cells2; do k = 1, cells(3); do i = 1,cells1Red
@@ -720,11 +720,11 @@ end function utilities_scalarGradient
!--------------------------------------------------------------------------------------------------
function utilities_vectorDivergence(field) result(div)
- real(pReal), intent(in), dimension(3,cells(1),cells(2),cells3) :: field
- real(pReal), dimension( cells(1),cells(2),cells3) :: div
+ real(pREAL), intent(in), dimension(3,cells(1),cells(2),cells3) :: field
+ real(pREAL), dimension( cells(1),cells(2),cells3) :: div
- vectorField_real(1:3,cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pReal
+ vectorField_real(1:3,cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pREAL
vectorField_real(1:3,1:cells(1), 1:cells(2),1:cells3) = field
call fftw_mpi_execute_dft_r2c(planVectorForth,vectorField_real,vectorField_fourier)
scalarField_fourier(1:cells1Red,1:cells(3),1:cells2) = sum(vectorField_fourier(1:3,1:cells1Red,1:cells(3),1:cells2) &
@@ -741,19 +741,19 @@ end function utilities_vectorDivergence
subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,&
F,Delta_t,rotation_BC)
- real(pReal), intent(out), dimension(3,3,3,3) :: C_volAvg, C_minmaxAvg !< average stiffness
- real(pReal), intent(out), dimension(3,3) :: P_av !< average PK stress
- real(pReal), intent(out), dimension(3,3,cells(1),cells(2),cells3) :: P !< PK stress
- real(pReal), intent(in), dimension(3,3,cells(1),cells(2),cells3) :: F !< deformation gradient target
- real(pReal), intent(in) :: Delta_t !< loading time
+ real(pREAL), intent(out), dimension(3,3,3,3) :: C_volAvg, C_minmaxAvg !< average stiffness
+ real(pREAL), intent(out), dimension(3,3) :: P_av !< average PK stress
+ real(pREAL), intent(out), dimension(3,3,cells(1),cells(2),cells3) :: P !< PK stress
+ real(pREAL), intent(in), dimension(3,3,cells(1),cells(2),cells3) :: F !< deformation gradient target
+ real(pREAL), intent(in) :: Delta_t !< loading time
type(tRotation), intent(in), optional :: rotation_BC !< rotation of load frame
integer :: i
integer(MPI_INTEGER_KIND) :: err_MPI
- real(pReal), dimension(3,3,3,3) :: dPdF_max, dPdF_min
- real(pReal) :: dPdF_norm_max, dPdF_norm_min
- real(pReal), dimension(2) :: valueAndRank !< pair of min/max norm of dPdF to synchronize min/max of dPdF
+ real(pREAL), dimension(3,3,3,3) :: dPdF_max, dPdF_min
+ real(pREAL) :: dPdF_norm_max, dPdF_norm_min
+ real(pREAL), dimension(2) :: valueAndRank !< pair of min/max norm of dPdF to synchronize min/max of dPdF
print'(/,1x,a)', '... evaluating constitutive response ......................................'
flush(IO_STDOUT)
@@ -771,19 +771,19 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,&
call MPI_Allreduce(MPI_IN_PLACE,P_av,9_MPI_INTEGER_KIND,MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
if (present(rotation_BC)) then
- if (any(dNeq(rotation_BC%asQuaternion(), real([1.0, 0.0, 0.0, 0.0],pReal)))) &
+ if (any(dNeq(rotation_BC%asQuaternion(), real([1.0, 0.0, 0.0, 0.0],pREAL)))) &
print'(/,1x,a,/,2(3(2x,f12.4,1x)/),3(2x,f12.4,1x))', &
- 'Piola--Kirchhoff stress (lab) / MPa =', transpose(P_av)*1.e-6_pReal
+ 'Piola--Kirchhoff stress (lab) / MPa =', transpose(P_av)*1.e-6_pREAL
P_av = rotation_BC%rotate(P_av)
end if
print'(/,1x,a,/,2(3(2x,f12.4,1x)/),3(2x,f12.4,1x))', &
- 'Piola--Kirchhoff stress / MPa =', transpose(P_av)*1.e-6_pReal
+ 'Piola--Kirchhoff stress / MPa =', transpose(P_av)*1.e-6_pREAL
flush(IO_STDOUT)
- dPdF_max = 0.0_pReal
- dPdF_norm_max = 0.0_pReal
- dPdF_min = huge(1.0_pReal)
- dPdF_norm_min = huge(1.0_pReal)
+ dPdF_max = 0.0_pREAL
+ dPdF_norm_max = 0.0_pREAL
+ dPdF_min = huge(1.0_pREAL)
+ dPdF_norm_min = huge(1.0_pREAL)
do i = 1, product(cells(1:2))*cells3
if (dPdF_norm_max < sum(homogenization_dPdF(1:3,1:3,1:3,1:3,i)**2)) then
dPdF_max = homogenization_dPdF(1:3,1:3,1:3,1:3,i)
@@ -795,19 +795,19 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,&
end if
end do
- valueAndRank = [dPdF_norm_max,real(worldrank,pReal)]
+ valueAndRank = [dPdF_norm_max,real(worldrank,pREAL)]
call MPI_Allreduce(MPI_IN_PLACE,valueAndRank,1_MPI_INTEGER_KIND,MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
call MPI_Bcast(dPdF_max,81_MPI_INTEGER_KIND,MPI_DOUBLE,int(valueAndRank(2),MPI_INTEGER_KIND),MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
- valueAndRank = [dPdF_norm_min,real(worldrank,pReal)]
+ valueAndRank = [dPdF_norm_min,real(worldrank,pREAL)]
call MPI_Allreduce(MPI_IN_PLACE,valueAndRank,1_MPI_INTEGER_KIND,MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
call MPI_Bcast(dPdF_min,81_MPI_INTEGER_KIND,MPI_DOUBLE,int(valueAndRank(2),MPI_INTEGER_KIND),MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
- C_minmaxAvg = 0.5_pReal*(dPdF_max + dPdF_min)
+ C_minmaxAvg = 0.5_pREAL*(dPdF_max + dPdF_min)
C_volAvg = sum(homogenization_dPdF,dim=5)
call MPI_Allreduce(MPI_IN_PLACE,C_volAvg,81_MPI_INTEGER_KIND,MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,err_MPI)
@@ -823,16 +823,16 @@ end subroutine utilities_constitutiveResponse
!--------------------------------------------------------------------------------------------------
pure function utilities_calculateRate(heterogeneous,field0,field,dt,avRate)
- real(pReal), intent(in), dimension(3,3) :: &
+ real(pREAL), intent(in), dimension(3,3) :: &
avRate !< homogeneous addon
- real(pReal), intent(in) :: &
+ real(pREAL), intent(in) :: &
dt !< Delta_t between field0 and field
logical, intent(in) :: &
heterogeneous !< calculate field of rates
- real(pReal), intent(in), dimension(3,3,cells(1),cells(2),cells3) :: &
+ real(pREAL), intent(in), dimension(3,3,cells(1),cells(2),cells3) :: &
field0, & !< data of previous step
field !< data of current step
- real(pReal), dimension(3,3,cells(1),cells(2),cells3) :: &
+ real(pREAL), dimension(3,3,cells(1),cells(2),cells3) :: &
utilities_calculateRate
@@ -849,17 +849,17 @@ end function utilities_calculateRate
!--------------------------------------------------------------------------------------------------
function utilities_forwardField(Delta_t,field_lastInc,rate,aim)
- real(pReal), intent(in) :: &
+ real(pREAL), intent(in) :: &
Delta_t !< Delta_t of current step
- real(pReal), intent(in), dimension(3,3,cells(1),cells(2),cells3) :: &
+ real(pREAL), intent(in), dimension(3,3,cells(1),cells(2),cells3) :: &
field_lastInc, & !< initial field
rate !< rate by which to forward
- real(pReal), intent(in), optional, dimension(3,3) :: &
+ real(pREAL), intent(in), optional, dimension(3,3) :: &
aim !< average field value aim
- real(pReal), dimension(3,3,cells(1),cells(2),cells3) :: &
+ real(pREAL), dimension(3,3,cells(1),cells(2),cells3) :: &
utilities_forwardField
- real(pReal), dimension(3,3) :: fieldDiff !< - aim
+ real(pREAL), dimension(3,3) :: fieldDiff !< - aim
integer(MPI_INTEGER_KIND) :: err_MPI
@@ -885,42 +885,42 @@ pure function utilities_getFreqDerivative(k_s)
integer, intent(in), dimension(3) :: k_s !< indices of frequency
- complex(pReal), dimension(3) :: utilities_getFreqDerivative
+ complex(pREAL), dimension(3) :: utilities_getFreqDerivative
select case (spectral_derivative_ID)
case (DERIVATIVE_CONTINUOUS_ID)
- utilities_getFreqDerivative = cmplx(0.0_pReal, TAU*real(k_s,pReal)/geomSize,pReal)
+ utilities_getFreqDerivative = cmplx(0.0_pREAL, TAU*real(k_s,pREAL)/geomSize,pREAL)
case (DERIVATIVE_CENTRAL_DIFF_ID)
- utilities_getFreqDerivative = cmplx(0.0_pReal, sin(TAU*real(k_s,pReal)/real(cells,pReal)), pReal)/ &
- cmplx(2.0_pReal*geomSize/real(cells,pReal), 0.0_pReal, pReal)
+ utilities_getFreqDerivative = cmplx(0.0_pREAL, sin(TAU*real(k_s,pREAL)/real(cells,pREAL)), pREAL)/ &
+ cmplx(2.0_pREAL*geomSize/real(cells,pREAL), 0.0_pREAL, pREAL)
case (DERIVATIVE_FWBW_DIFF_ID)
utilities_getFreqDerivative(1) = &
- cmplx(cos(TAU*real(k_s(1),pReal)/real(cells(1),pReal)) - 1.0_pReal, &
- sin(TAU*real(k_s(1),pReal)/real(cells(1),pReal)), pReal)* &
- cmplx(cos(TAU*real(k_s(2),pReal)/real(cells(2),pReal)) + 1.0_pReal, &
- sin(TAU*real(k_s(2),pReal)/real(cells(2),pReal)), pReal)* &
- cmplx(cos(TAU*real(k_s(3),pReal)/real(cells(3),pReal)) + 1.0_pReal, &
- sin(TAU*real(k_s(3),pReal)/real(cells(3),pReal)), pReal)/ &
- cmplx(4.0_pReal*geomSize(1)/real(cells(1),pReal), 0.0_pReal, pReal)
+ cmplx(cos(TAU*real(k_s(1),pREAL)/real(cells(1),pREAL)) - 1.0_pREAL, &
+ sin(TAU*real(k_s(1),pREAL)/real(cells(1),pREAL)), pREAL)* &
+ cmplx(cos(TAU*real(k_s(2),pREAL)/real(cells(2),pREAL)) + 1.0_pREAL, &
+ sin(TAU*real(k_s(2),pREAL)/real(cells(2),pREAL)), pREAL)* &
+ cmplx(cos(TAU*real(k_s(3),pREAL)/real(cells(3),pREAL)) + 1.0_pREAL, &
+ sin(TAU*real(k_s(3),pREAL)/real(cells(3),pREAL)), pREAL)/ &
+ cmplx(4.0_pREAL*geomSize(1)/real(cells(1),pREAL), 0.0_pREAL, pREAL)
utilities_getFreqDerivative(2) = &
- cmplx(cos(TAU*real(k_s(1),pReal)/real(cells(1),pReal)) + 1.0_pReal, &
- sin(TAU*real(k_s(1),pReal)/real(cells(1),pReal)), pReal)* &
- cmplx(cos(TAU*real(k_s(2),pReal)/real(cells(2),pReal)) - 1.0_pReal, &
- sin(TAU*real(k_s(2),pReal)/real(cells(2),pReal)), pReal)* &
- cmplx(cos(TAU*real(k_s(3),pReal)/real(cells(3),pReal)) + 1.0_pReal, &
- sin(TAU*real(k_s(3),pReal)/real(cells(3),pReal)), pReal)/ &
- cmplx(4.0_pReal*geomSize(2)/real(cells(2),pReal), 0.0_pReal, pReal)
+ cmplx(cos(TAU*real(k_s(1),pREAL)/real(cells(1),pREAL)) + 1.0_pREAL, &
+ sin(TAU*real(k_s(1),pREAL)/real(cells(1),pREAL)), pREAL)* &
+ cmplx(cos(TAU*real(k_s(2),pREAL)/real(cells(2),pREAL)) - 1.0_pREAL, &
+ sin(TAU*real(k_s(2),pREAL)/real(cells(2),pREAL)), pREAL)* &
+ cmplx(cos(TAU*real(k_s(3),pREAL)/real(cells(3),pREAL)) + 1.0_pREAL, &
+ sin(TAU*real(k_s(3),pREAL)/real(cells(3),pREAL)), pREAL)/ &
+ cmplx(4.0_pREAL*geomSize(2)/real(cells(2),pREAL), 0.0_pREAL, pREAL)
utilities_getFreqDerivative(3) = &
- cmplx(cos(TAU*real(k_s(1),pReal)/real(cells(1),pReal)) + 1.0_pReal, &
- sin(TAU*real(k_s(1),pReal)/real(cells(1),pReal)), pReal)* &
- cmplx(cos(TAU*real(k_s(2),pReal)/real(cells(2),pReal)) + 1.0_pReal, &
- sin(TAU*real(k_s(2),pReal)/real(cells(2),pReal)), pReal)* &
- cmplx(cos(TAU*real(k_s(3),pReal)/real(cells(3),pReal)) - 1.0_pReal, &
- sin(TAU*real(k_s(3),pReal)/real(cells(3),pReal)), pReal)/ &
- cmplx(4.0_pReal*geomSize(3)/real(cells(3),pReal), 0.0_pReal, pReal)
+ cmplx(cos(TAU*real(k_s(1),pREAL)/real(cells(1),pREAL)) + 1.0_pREAL, &
+ sin(TAU*real(k_s(1),pREAL)/real(cells(1),pREAL)), pREAL)* &
+ cmplx(cos(TAU*real(k_s(2),pREAL)/real(cells(2),pREAL)) + 1.0_pREAL, &
+ sin(TAU*real(k_s(2),pREAL)/real(cells(2),pREAL)), pREAL)* &
+ cmplx(cos(TAU*real(k_s(3),pREAL)/real(cells(3),pREAL)) - 1.0_pREAL, &
+ sin(TAU*real(k_s(3),pREAL)/real(cells(3),pREAL)), pREAL)/ &
+ cmplx(4.0_pREAL*geomSize(3)/real(cells(3),pREAL), 0.0_pREAL, pREAL)
end select
end function utilities_getFreqDerivative
@@ -932,11 +932,11 @@ end function utilities_getFreqDerivative
!--------------------------------------------------------------------------------------------------
subroutine utilities_updateCoords(F)
- real(pReal), dimension(3,3,cells(1),cells(2),cells3), intent(in) :: F
+ real(pREAL), dimension(3,3,cells(1),cells(2),cells3), intent(in) :: F
- real(pReal), dimension(3, cells(1),cells(2),cells3) :: x_p !< Point/cell center coordinates
- real(pReal), dimension(3, cells(1),cells(2),0:cells3+1) :: u_tilde_p_padded !< Fluctuation of cell center displacement (padded along z for MPI)
- real(pReal), dimension(3, cells(1)+1,cells(2)+1,cells3+1) :: x_n !< Node coordinates
+ real(pREAL), dimension(3, cells(1),cells(2),cells3) :: x_p !< Point/cell center coordinates
+ real(pREAL), dimension(3, cells(1),cells(2),0:cells3+1) :: u_tilde_p_padded !< Fluctuation of cell center displacement (padded along z for MPI)
+ real(pREAL), dimension(3, cells(1)+1,cells(2)+1,cells3+1) :: x_n !< Node coordinates
integer :: &
i,j,k,n, &
c
@@ -950,8 +950,8 @@ subroutine utilities_updateCoords(F)
integer, dimension(4) :: request
integer, dimension(MPI_STATUS_SIZE,4) :: status
#endif
- real(pReal), dimension(3) :: step
- real(pReal), dimension(3,3) :: Favg
+ real(pREAL), dimension(3) :: step
+ real(pREAL), dimension(3,3) :: Favg
integer, dimension(3) :: me
integer, dimension(3,8) :: &
neighbor = reshape([ &
@@ -965,10 +965,10 @@ subroutine utilities_updateCoords(F)
0, 1, 1 ], [3,8])
- step = geomSize/real(cells, pReal)
+ step = geomSize/real(cells, pREAL)
tensorField_real(1:3,1:3,1:cells(1), 1:cells(2),1:cells3) = F
- tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pReal
+ tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pREAL
call fftw_mpi_execute_dft_r2c(planTensorForth,tensorField_real,tensorField_fourier)
!--------------------------------------------------------------------------------------------------
@@ -985,7 +985,7 @@ subroutine utilities_updateCoords(F)
vectorField_fourier(1:3,i,k,j) = matmul(tensorField_fourier(1:3,1:3,i,k,j),xi2nd(1:3,i,k,j)) &
/ sum(conjg(-xi2nd(1:3,i,k,j))*xi2nd(1:3,i,k,j))
else
- vectorField_fourier(1:3,i,k,j) = cmplx(0.0,0.0,pReal)
+ vectorField_fourier(1:3,i,k,j) = cmplx(0.0,0.0,pREAL)
end if
end do; end do; end do
!$OMP END PARALLEL DO
@@ -1021,13 +1021,13 @@ subroutine utilities_updateCoords(F)
!--------------------------------------------------------------------------------------------------
! calculate nodal positions
- x_n = 0.0_pReal
+ x_n = 0.0_pREAL
do j = 0,cells(2); do k = 0,cells3; do i = 0,cells(1)
- x_n(1:3,i+1,j+1,k+1) = matmul(Favg,step*(real([i,j,k+cells3Offset],pReal)))
+ x_n(1:3,i+1,j+1,k+1) = matmul(Favg,step*(real([i,j,k+cells3Offset],pREAL)))
averageFluct: do n = 1,8
me = [i+neighbor(1,n),j+neighbor(2,n),k+neighbor(3,n)]
x_n(1:3,i+1,j+1,k+1) = x_n(1:3,i+1,j+1,k+1) &
- + u_tilde_p_padded(1:3,modulo(me(1)-1,cells(1))+1,modulo(me(2)-1,cells(2))+1,me(3))*0.125_pReal
+ + u_tilde_p_padded(1:3,modulo(me(1)-1,cells(1))+1,modulo(me(2)-1,cells(2))+1,me(3))*0.125_pREAL
end do averageFluct
end do; end do; end do
@@ -1035,7 +1035,7 @@ subroutine utilities_updateCoords(F)
! calculate cell center/point positions
do k = 1,cells3; do j = 1,cells(2); do i = 1,cells(1)
x_p(1:3,i,j,k) = u_tilde_p_padded(1:3,i,j,k) &
- + matmul(Favg,step*(real([i,j,k+cells3Offset],pReal)-0.5_pReal))
+ + matmul(Favg,step*(real([i,j,k+cells3Offset],pREAL)-0.5_pREAL))
end do; end do; end do
call discretization_setNodeCoords(reshape(x_n,[3,(cells(1)+1)*(cells(2)+1)*(cells3+1)]))
@@ -1049,62 +1049,62 @@ end subroutine utilities_updateCoords
!--------------------------------------------------------------------------------------------------
subroutine selfTest()
- real(pReal), allocatable, dimension(:,:,:,:,:) :: tensorField_real_
- real(pReal), allocatable, dimension(:,:,:,:) :: vectorField_real_
- real(pReal), allocatable, dimension(:,:,:) :: scalarField_real_
- real(pReal), dimension(3,3) :: tensorSum
- real(pReal), dimension(3) :: vectorSum
- real(pReal) :: scalarSum
- real(pReal), dimension(3,3) :: r
+ real(pREAL), allocatable, dimension(:,:,:,:,:) :: tensorField_real_
+ real(pREAL), allocatable, dimension(:,:,:,:) :: vectorField_real_
+ real(pREAL), allocatable, dimension(:,:,:) :: scalarField_real_
+ real(pREAL), dimension(3,3) :: tensorSum
+ real(pREAL), dimension(3) :: vectorSum
+ real(pREAL) :: scalarSum
+ real(pREAL), dimension(3,3) :: r
integer(MPI_INTEGER_KIND) :: err_MPI
call random_number(tensorField_real)
- tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pReal
+ tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pREAL
tensorField_real_ = tensorField_real
call fftw_mpi_execute_dft_r2c(planTensorForth,tensorField_real,tensorField_fourier)
call MPI_Allreduce(sum(sum(sum(tensorField_real_,dim=5),dim=4),dim=3),tensorSum,9_MPI_INTEGER_KIND, &
MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
if (worldrank==0) then
- if (any(dNeq(tensorSum/tensorField_fourier(:,:,1,1,1)%re,1.0_pReal,1.0e-12_pReal))) &
+ if (any(dNeq(tensorSum/tensorField_fourier(:,:,1,1,1)%re,1.0_pREAL,1.0e-12_pREAL))) &
error stop 'mismatch avg tensorField FFT <-> real'
end if
call fftw_mpi_execute_dft_c2r(planTensorBack,tensorField_fourier,tensorField_real)
- tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pReal
- if (maxval(abs(tensorField_real_ - tensorField_real*wgt))>5.0e-15_pReal) &
+ tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pREAL
+ if (maxval(abs(tensorField_real_ - tensorField_real*wgt))>5.0e-15_pREAL) &
error stop 'mismatch tensorField FFT/invFFT <-> real'
call random_number(vectorField_real)
- vectorField_real(1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pReal
+ vectorField_real(1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pREAL
vectorField_real_ = vectorField_real
call fftw_mpi_execute_dft_r2c(planVectorForth,vectorField_real,vectorField_fourier)
call MPI_Allreduce(sum(sum(sum(vectorField_real_,dim=4),dim=3),dim=2),vectorSum,3_MPI_INTEGER_KIND, &
MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
if (worldrank==0) then
- if (any(dNeq(vectorSum/vectorField_fourier(:,1,1,1)%re,1.0_pReal,1.0e-12_pReal))) &
+ if (any(dNeq(vectorSum/vectorField_fourier(:,1,1,1)%re,1.0_pREAL,1.0e-12_pREAL))) &
error stop 'mismatch avg vectorField FFT <-> real'
end if
call fftw_mpi_execute_dft_c2r(planVectorBack,vectorField_fourier,vectorField_real)
- vectorField_real(1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pReal
- if (maxval(abs(vectorField_real_ - vectorField_real*wgt))>5.0e-15_pReal) &
+ vectorField_real(1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pREAL
+ if (maxval(abs(vectorField_real_ - vectorField_real*wgt))>5.0e-15_pREAL) &
error stop 'mismatch vectorField FFT/invFFT <-> real'
call random_number(scalarField_real)
- scalarField_real(cells(1)+1:cells1Red*2,:,:) = 0.0_pReal
+ scalarField_real(cells(1)+1:cells1Red*2,:,:) = 0.0_pREAL
scalarField_real_ = scalarField_real
call fftw_mpi_execute_dft_r2c(planScalarForth,scalarField_real,scalarField_fourier)
call MPI_Allreduce(sum(sum(sum(scalarField_real_,dim=3),dim=2),dim=1),scalarSum,1_MPI_INTEGER_KIND, &
MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
if (worldrank==0) then
- if (dNeq(scalarSum/scalarField_fourier(1,1,1)%re,1.0_pReal,1.0e-12_pReal)) &
+ if (dNeq(scalarSum/scalarField_fourier(1,1,1)%re,1.0_pREAL,1.0e-12_pREAL)) &
error stop 'mismatch avg scalarField FFT <-> real'
end if
call fftw_mpi_execute_dft_c2r(planScalarBack,scalarField_fourier,scalarField_real)
- scalarField_real(cells(1)+1:cells1Red*2,:,:) = 0.0_pReal
- if (maxval(abs(scalarField_real_ - scalarField_real*wgt))>5.0e-15_pReal) &
+ scalarField_real(cells(1)+1:cells1Red*2,:,:) = 0.0_pREAL
+ if (maxval(abs(scalarField_real_ - scalarField_real*wgt))>5.0e-15_pREAL) &
error stop 'mismatch scalarField FFT/invFFT <-> real'
call random_number(r)
@@ -1112,54 +1112,54 @@ subroutine selfTest()
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
scalarField_real_ = r(1,1)
- if (maxval(abs(utilities_scalarGradient(scalarField_real_)))>5.0e-9_pReal) error stop 'non-zero grad(const)'
+ if (maxval(abs(utilities_scalarGradient(scalarField_real_)))>5.0e-9_pREAL) error stop 'non-zero grad(const)'
vectorField_real_ = spread(spread(spread(r(1,:),2,cells(1)),3,cells(2)),4,cells3)
- if (maxval(abs(utilities_vectorDivergence(vectorField_real_)))>5.0e-9_pReal) error stop 'non-zero div(const)'
+ if (maxval(abs(utilities_vectorDivergence(vectorField_real_)))>5.0e-9_pREAL) error stop 'non-zero div(const)'
tensorField_real_ = spread(spread(spread(r,3,cells(1)),4,cells(2)),5,cells3)
- if (utilities_divergenceRMS(tensorField_real_)>5.0e-14_pReal) error stop 'non-zero RMS div(const)'
- if (utilities_curlRMS(tensorField_real_)>5.0e-14_pReal) error stop 'non-zero RMS curl(const)'
+ if (utilities_divergenceRMS(tensorField_real_)>5.0e-14_pREAL) error stop 'non-zero RMS div(const)'
+ if (utilities_curlRMS(tensorField_real_)>5.0e-14_pREAL) error stop 'non-zero RMS curl(const)'
if (cells(1) > 2 .and. spectral_derivative_ID == DERIVATIVE_CONTINUOUS_ID) then
scalarField_real_ = spread(spread(planeCosine(cells(1)),2,cells(2)),3,cells3)
vectorField_real_ = utilities_scalarGradient(scalarField_real_)/TAU*geomSize(1)
scalarField_real_ = -spread(spread(planeSine (cells(1)),2,cells(2)),3,cells3)
- if (maxval(abs(vectorField_real_(1,:,:,:) - scalarField_real_))>5.0e-12_pReal) error stop 'grad cosine'
+ if (maxval(abs(vectorField_real_(1,:,:,:) - scalarField_real_))>5.0e-12_pREAL) error stop 'grad cosine'
scalarField_real_ = spread(spread(planeSine (cells(1)),2,cells(2)),3,cells3)
vectorField_real_ = utilities_scalarGradient(scalarField_real_)/TAU*geomSize(1)
scalarField_real_ = spread(spread(planeCosine(cells(1)),2,cells(2)),3,cells3)
- if (maxval(abs(vectorField_real_(1,:,:,:) - scalarField_real_))>5.0e-12_pReal) error stop 'grad sine'
+ if (maxval(abs(vectorField_real_(1,:,:,:) - scalarField_real_))>5.0e-12_pREAL) error stop 'grad sine'
- vectorField_real_(2:3,:,:,:) = 0.0_pReal
+ vectorField_real_(2:3,:,:,:) = 0.0_pREAL
vectorField_real_(1,:,:,:) = spread(spread(planeCosine(cells(1)),2,cells(2)),3,cells3)
scalarField_real_ = utilities_vectorDivergence(vectorField_real_)/TAU*geomSize(1)
vectorField_real_(1,:,:,:) =-spread(spread(planeSine( cells(1)),2,cells(2)),3,cells3)
- if (maxval(abs(vectorField_real_(1,:,:,:) - scalarField_real_))>5.0e-12_pReal) error stop 'div cosine'
- vectorField_real_(2:3,:,:,:) = 0.0_pReal
+ if (maxval(abs(vectorField_real_(1,:,:,:) - scalarField_real_))>5.0e-12_pREAL) error stop 'div cosine'
+ vectorField_real_(2:3,:,:,:) = 0.0_pREAL
vectorField_real_(1,:,:,:) = spread(spread(planeSine( cells(1)),2,cells(2)),3,cells3)
scalarField_real_ = utilities_vectorDivergence(vectorField_real_)/TAU*geomSize(1)
vectorField_real_(1,:,:,:) = spread(spread(planeCosine(cells(1)),2,cells(2)),3,cells3)
- if (maxval(abs(vectorField_real_(1,:,:,:) - scalarField_real_))>5.0e-12_pReal) error stop 'div sine'
+ if (maxval(abs(vectorField_real_(1,:,:,:) - scalarField_real_))>5.0e-12_pREAL) error stop 'div sine'
end if
contains
function planeCosine(n)
integer, intent(in) :: n
- real(pReal), dimension(n) :: planeCosine
+ real(pREAL), dimension(n) :: planeCosine
- planeCosine = cos(real(math_range(n),pReal)/real(n,pReal)*TAU-TAU/real(n*2,pReal))
+ planeCosine = cos(real(math_range(n),pREAL)/real(n,pREAL)*TAU-TAU/real(n*2,pREAL))
end function planeCosine
function planeSine(n)
integer, intent(in) :: n
- real(pReal), dimension(n) :: planeSine
+ real(pREAL), dimension(n) :: planeSine
- planeSine = sin(real(math_range(n),pReal)/real(n,pReal)*TAU-TAU/real(n*2,pReal))
+ planeSine = sin(real(math_range(n),pREAL)/real(n,pREAL)*TAU-TAU/real(n*2,pREAL))
end function planeSine
diff --git a/src/homogenization.f90 b/src/homogenization.f90
index 778a094b4..f322c2c07 100644
--- a/src/homogenization.f90
+++ b/src/homogenization.f90
@@ -25,7 +25,7 @@ module homogenization
integer :: &
sizeState = 0 !< size of state
! http://stackoverflow.com/questions/3948210
- real(pReal), pointer, dimension(:,:), contiguous :: & !< is basically an allocatable+target, but in a type needs to be pointer
+ real(pREAL), pointer, dimension(:,:), contiguous :: & !< is basically an allocatable+target, but in a type needs to be pointer
state0, &
state
end type
@@ -51,12 +51,12 @@ module homogenization
!--------------------------------------------------------------------------------------------------
! General variables for the homogenization at a material point
- real(pReal), dimension(:,:,:), allocatable, public :: &
+ real(pREAL), dimension(:,:,:), allocatable, public :: &
homogenization_F0, & !< def grad of IP at start of FE increment
homogenization_F !< def grad of IP to be reached at end of FE increment
- real(pReal), dimension(:,:,:), allocatable, public :: & !, protected :: & Issue with ifort
+ real(pREAL), dimension(:,:,:), allocatable, public :: & !, protected :: & Issue with ifort
homogenization_P !< first P--K stress of IP
- real(pReal), dimension(:,:,:,:,:), allocatable, public :: & !, protected :: &
+ real(pREAL), dimension(:,:,:,:,:), allocatable, public :: & !, protected :: &
homogenization_dPdF !< tangent of first P--K stress at IP
@@ -81,7 +81,7 @@ module homogenization
end subroutine damage_init
module subroutine mechanical_partition(subF,ce)
- real(pReal), intent(in), dimension(3,3) :: &
+ real(pREAL), intent(in), dimension(3,3) :: &
subF
integer, intent(in) :: &
ce
@@ -96,7 +96,7 @@ module homogenization
end subroutine damage_partition
module subroutine mechanical_homogenize(Delta_t,ce)
- real(pReal), intent(in) :: Delta_t
+ real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: &
ce !< cell
end subroutine mechanical_homogenize
@@ -117,9 +117,9 @@ module homogenization
end subroutine thermal_result
module function mechanical_updateState(subdt,subF,ce) result(doneAndHappy)
- real(pReal), intent(in) :: &
+ real(pREAL), intent(in) :: &
subdt !< current time step
- real(pReal), intent(in), dimension(3,3) :: &
+ real(pREAL), intent(in), dimension(3,3) :: &
subF
integer, intent(in) :: &
ce !< cell
@@ -132,22 +132,22 @@ module homogenization
module function homogenization_mu_T(ce) result(mu)
integer, intent(in) :: ce
- real(pReal) :: mu
+ real(pREAL) :: mu
end function homogenization_mu_T
module function homogenization_K_T(ce) result(K)
integer, intent(in) :: ce
- real(pReal), dimension(3,3) :: K
+ real(pREAL), dimension(3,3) :: K
end function homogenization_K_T
module function homogenization_f_T(ce) result(f)
integer, intent(in) :: ce
- real(pReal) :: f
+ real(pREAL) :: f
end function homogenization_f_T
module subroutine homogenization_thermal_setField(T,dot_T, ce)
integer, intent(in) :: ce
- real(pReal), intent(in) :: T, dot_T
+ real(pREAL), intent(in) :: T, dot_T
end subroutine homogenization_thermal_setField
module function homogenization_damage_active() result(active)
@@ -156,23 +156,23 @@ module homogenization
module function homogenization_mu_phi(ce) result(mu)
integer, intent(in) :: ce
- real(pReal) :: mu
+ real(pREAL) :: mu
end function homogenization_mu_phi
module function homogenization_K_phi(ce) result(K)
integer, intent(in) :: ce
- real(pReal), dimension(3,3) :: K
+ real(pREAL), dimension(3,3) :: K
end function homogenization_K_phi
module function homogenization_f_phi(phi,ce) result(f)
integer, intent(in) :: ce
- real(pReal), intent(in) :: phi
- real(pReal) :: f
+ real(pREAL), intent(in) :: phi
+ real(pREAL) :: f
end function homogenization_f_phi
module subroutine homogenization_set_phi(phi,ce)
integer, intent(in) :: ce
- real(pReal), intent(in) :: &
+ real(pREAL), intent(in) :: &
phi
end subroutine homogenization_set_phi
@@ -235,7 +235,7 @@ end subroutine homogenization_init
!--------------------------------------------------------------------------------------------------
subroutine homogenization_mechanical_response(Delta_t,cell_start,cell_end)
- real(pReal), intent(in) :: Delta_t !< time increment
+ real(pREAL), intent(in) :: Delta_t !< time increment
integer, intent(in) :: &
cell_start, cell_end
integer :: &
@@ -293,7 +293,7 @@ end subroutine homogenization_mechanical_response
!--------------------------------------------------------------------------------------------------
subroutine homogenization_thermal_response(Delta_t,cell_start,cell_end)
- real(pReal), intent(in) :: Delta_t !< time increment
+ real(pREAL), intent(in) :: Delta_t !< time increment
integer, intent(in) :: &
cell_start, cell_end
integer :: &
@@ -321,7 +321,7 @@ end subroutine homogenization_thermal_response
!--------------------------------------------------------------------------------------------------
subroutine homogenization_mechanical_response2(Delta_t,FEsolving_execIP,FEsolving_execElem)
- real(pReal), intent(in) :: Delta_t !< time increment
+ real(pREAL), intent(in) :: Delta_t !< time increment
integer, dimension(2), intent(in) :: FEsolving_execElem, FEsolving_execIP
integer :: &
ip, & !< integration point number
@@ -482,7 +482,7 @@ subroutine parseHomogenization
if (homog%contains('thermal')) then
homogThermal => homog%get_dict('thermal')
- select case (homogThermal%get_asString('type'))
+ select case (homogThermal%get_asStr('type'))
case('pass')
thermal_type(h) = THERMAL_PASS_ID
thermal_active(h) = .true.
@@ -490,17 +490,17 @@ subroutine parseHomogenization
thermal_type(h) = THERMAL_ISOTEMPERATURE_ID
thermal_active(h) = .true.
case default
- call IO_error(500,ext_msg=homogThermal%get_asString('type'))
+ call IO_error(500,ext_msg=homogThermal%get_asStr('type'))
end select
end if
if (homog%contains('damage')) then
homogDamage => homog%get_dict('damage')
- select case (homogDamage%get_asString('type'))
+ select case (homogDamage%get_asStr('type'))
case('pass')
damage_active(h) = .true.
case default
- call IO_error(500,ext_msg=homogDamage%get_asString('type'))
+ call IO_error(500,ext_msg=homogDamage%get_asStr('type'))
end select
end if
end do
diff --git a/src/homogenization_damage.f90 b/src/homogenization_damage.f90
index 703f546d0..466b8b47b 100644
--- a/src/homogenization_damage.f90
+++ b/src/homogenization_damage.f90
@@ -11,13 +11,13 @@ submodule(homogenization) damage
end interface
type :: tDataContainer
- real(pReal), dimension(:), allocatable :: phi
+ real(pREAL), dimension(:), allocatable :: phi
end type tDataContainer
type(tDataContainer), dimension(:), allocatable :: current
type :: tParameters
- character(len=pStringLen), allocatable, dimension(:) :: &
+ character(len=pSTRLEN), allocatable, dimension(:) :: &
output
end type tParameters
@@ -48,21 +48,21 @@ module subroutine damage_init()
do ho = 1, configHomogenizations%length
Nmembers = count(material_ID_homogenization == ho)
- allocate(current(ho)%phi(Nmembers), source=1.0_pReal)
+ allocate(current(ho)%phi(Nmembers), source=1.0_pREAL)
configHomogenization => configHomogenizations%get_dict(ho)
associate(prm => param(ho))
if (configHomogenization%contains('damage')) then
configHomogenizationDamage => configHomogenization%get_dict('damage')
#if defined (__GFORTRAN__)
- prm%output = output_as1dString(configHomogenizationDamage)
+ prm%output = output_as1dStr(configHomogenizationDamage)
#else
- prm%output = configHomogenizationDamage%get_as1dString('output',defaultVal=emptyStringArray)
+ prm%output = configHomogenizationDamage%get_as1dStr('output',defaultVal=emptyStrArray)
#endif
damageState_h(ho)%sizeState = 1
- allocate(damageState_h(ho)%state0(1,Nmembers), source=1.0_pReal)
- allocate(damageState_h(ho)%state (1,Nmembers), source=1.0_pReal)
+ allocate(damageState_h(ho)%state0(1,Nmembers), source=1.0_pREAL)
+ allocate(damageState_h(ho)%state (1,Nmembers), source=1.0_pREAL)
else
- prm%output = emptyStringArray
+ prm%output = emptyStrArray
end if
end associate
end do
@@ -91,7 +91,7 @@ module subroutine damage_partition(ce)
integer, intent(in) :: ce
- real(pReal) :: phi
+ real(pREAL) :: phi
integer :: co
@@ -111,7 +111,7 @@ end subroutine damage_partition
module function homogenization_mu_phi(ce) result(mu)
integer, intent(in) :: ce
- real(pReal) :: mu
+ real(pREAL) :: mu
mu = phase_mu_phi(1,ce)
@@ -125,7 +125,7 @@ end function homogenization_mu_phi
module function homogenization_K_phi(ce) result(K)
integer, intent(in) :: ce
- real(pReal), dimension(3,3) :: K
+ real(pREAL), dimension(3,3) :: K
K = phase_K_phi(1,ce)
@@ -139,8 +139,8 @@ end function homogenization_K_phi
module function homogenization_f_phi(phi,ce) result(f)
integer, intent(in) :: ce
- real(pReal), intent(in) :: phi
- real(pReal) :: f
+ real(pREAL), intent(in) :: phi
+ real(pREAL) :: f
f = phase_f_phi(phi, 1, ce)
@@ -154,7 +154,7 @@ end function homogenization_f_phi
module subroutine homogenization_set_phi(phi,ce)
integer, intent(in) :: ce
- real(pReal), intent(in) :: phi
+ real(pREAL), intent(in) :: phi
integer :: &
ho, &
diff --git a/src/homogenization_mechanical.f90 b/src/homogenization_mechanical.f90
index 24625769e..31bd42aa5 100644
--- a/src/homogenization_mechanical.f90
+++ b/src/homogenization_mechanical.f90
@@ -18,13 +18,13 @@ submodule(homogenization) mechanical
module subroutine isostrain_partitionDeformation(F,avgF)
- real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient
- real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point
+ real(pREAL), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient
+ real(pREAL), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point
end subroutine isostrain_partitionDeformation
module subroutine RGC_partitionDeformation(F,avgF,ce)
- real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient
- real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point
+ real(pREAL), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient
+ real(pREAL), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point
integer, intent(in) :: &
ce
end subroutine RGC_partitionDeformation
@@ -32,12 +32,12 @@ submodule(homogenization) mechanical
module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
logical, dimension(2) :: doneAndHappy
- real(pReal), dimension(:,:,:), intent(in) :: &
+ real(pREAL), dimension(:,:,:), intent(in) :: &
P,& !< partitioned stresses
F !< partitioned deformation gradients
- real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses
- real(pReal), dimension(3,3), intent(in) :: avgF !< average F
- real(pReal), intent(in) :: dt !< time increment
+ real(pREAL), dimension(:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses
+ real(pREAL), dimension(3,3), intent(in) :: avgF !< average F
+ real(pREAL), intent(in) :: dt !< time increment
integer, intent(in) :: &
ce !< cell
end function RGC_updateState
@@ -51,7 +51,7 @@ submodule(homogenization) mechanical
end interface
type :: tOutput !< requested output (per phase)
- character(len=pStringLen), allocatable, dimension(:) :: &
+ character(len=pSTRLEN), allocatable, dimension(:) :: &
label
end type tOutput
type(tOutput), allocatable, dimension(:) :: output_mechanical
@@ -63,7 +63,7 @@ submodule(homogenization) mechanical
MECHANICAL_RGC_ID
end enum
integer(kind(MECHANICAL_UNDEFINED_ID)), dimension(:), allocatable :: &
- mechanical_type !< type of each homogenization
+ mechanical_type !< type of each homogenization
contains
@@ -76,10 +76,10 @@ module subroutine mechanical_init()
call parseMechanical()
- allocate(homogenization_dPdF(3,3,3,3,discretization_Ncells), source=0.0_pReal)
+ allocate(homogenization_dPdF(3,3,3,3,discretization_Ncells), source=0.0_pREAL)
homogenization_F0 = spread(math_I3,3,discretization_Ncells)
homogenization_F = homogenization_F0
- allocate(homogenization_P(3,3,discretization_Ncells),source=0.0_pReal)
+ allocate(homogenization_P(3,3,discretization_Ncells),source=0.0_pREAL)
if (any(mechanical_type == MECHANICAL_PASS_ID)) call pass_init()
if (any(mechanical_type == MECHANICAL_ISOSTRAIN_ID)) call isostrain_init()
@@ -93,13 +93,13 @@ end subroutine mechanical_init
!--------------------------------------------------------------------------------------------------
module subroutine mechanical_partition(subF,ce)
- real(pReal), intent(in), dimension(3,3) :: &
+ real(pREAL), intent(in), dimension(3,3) :: &
subF
integer, intent(in) :: &
ce
integer :: co
- real(pReal), dimension (3,3,homogenization_Nconstituents(material_ID_homogenization(ce))) :: Fs
+ real(pREAL), dimension (3,3,homogenization_Nconstituents(material_ID_homogenization(ce))) :: Fs
chosenHomogenization: select case(mechanical_type(material_ID_homogenization(ce)))
@@ -128,7 +128,7 @@ end subroutine mechanical_partition
!--------------------------------------------------------------------------------------------------
module subroutine mechanical_homogenize(Delta_t,ce)
- real(pReal), intent(in) :: Delta_t
+ real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: ce
integer :: co
@@ -152,18 +152,18 @@ end subroutine mechanical_homogenize
!--------------------------------------------------------------------------------------------------
module function mechanical_updateState(subdt,subF,ce) result(doneAndHappy)
- real(pReal), intent(in) :: &
+ real(pREAL), intent(in) :: &
subdt !< current time step
- real(pReal), intent(in), dimension(3,3) :: &
+ real(pREAL), intent(in), dimension(3,3) :: &
subF
integer, intent(in) :: &
ce
logical, dimension(2) :: doneAndHappy
integer :: co
- real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_ID_homogenization(ce)))
- real(pReal) :: Fs(3,3,homogenization_Nconstituents(material_ID_homogenization(ce)))
- real(pReal) :: Ps(3,3,homogenization_Nconstituents(material_ID_homogenization(ce)))
+ real(pREAL) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_ID_homogenization(ce)))
+ real(pREAL) :: Fs(3,3,homogenization_Nconstituents(material_ID_homogenization(ce)))
+ real(pREAL) :: Ps(3,3,homogenization_Nconstituents(material_ID_homogenization(ce)))
if (mechanical_type(material_ID_homogenization(ce)) == MECHANICAL_RGC_ID) then
@@ -239,11 +239,11 @@ subroutine parseMechanical()
homog => material_homogenization%get_dict(ho)
mechanical => homog%get_dict('mechanical')
#if defined(__GFORTRAN__)
- output_mechanical(ho)%label = output_as1dString(mechanical)
+ output_mechanical(ho)%label = output_as1dStr(mechanical)
#else
- output_mechanical(ho)%label = mechanical%get_as1dString('output',defaultVal=emptyStringArray)
+ output_mechanical(ho)%label = mechanical%get_as1dStr('output',defaultVal=emptyStrArray)
#endif
- select case (mechanical%get_asString('type'))
+ select case (mechanical%get_asStr('type'))
case('pass')
mechanical_type(ho) = MECHANICAL_PASS_ID
case('isostrain')
@@ -251,7 +251,7 @@ subroutine parseMechanical()
case('RGC')
mechanical_type(ho) = MECHANICAL_RGC_ID
case default
- call IO_error(500,ext_msg=mechanical%get_asString('type'))
+ call IO_error(500,ext_msg=mechanical%get_asStr('type'))
end select
end do
diff --git a/src/homogenization_mechanical_RGC.f90 b/src/homogenization_mechanical_RGC.f90
index 0e85fcca6..da8bce7c5 100644
--- a/src/homogenization_mechanical_RGC.f90
+++ b/src/homogenization_mechanical_RGC.f90
@@ -13,34 +13,34 @@ submodule(homogenization:mechanical) RGC
type :: tParameters
integer, dimension(:), allocatable :: &
N_constituents
- real(pReal) :: &
+ real(pREAL) :: &
xi_alpha, &
c_Alpha
- real(pReal), dimension(:), allocatable :: &
+ real(pREAL), dimension(:), allocatable :: &
D_alpha, &
a_g
- character(len=pStringLen), allocatable, dimension(:) :: &
+ character(len=pSTRLEN), allocatable, dimension(:) :: &
output
end type tParameters
type :: tRGCstate
- real(pReal), pointer, dimension(:,:) :: &
+ real(pREAL), pointer, dimension(:,:) :: &
relaxationVector
end type tRGCstate
type :: tRGCdependentState
- real(pReal), allocatable, dimension(:) :: &
+ real(pREAL), allocatable, dimension(:) :: &
volumeDiscrepancy, &
relaxationRate_avg, &
relaxationRate_max
- real(pReal), allocatable, dimension(:,:) :: &
+ real(pREAL), allocatable, dimension(:,:) :: &
mismatch
- real(pReal), allocatable, dimension(:,:,:) :: &
+ real(pREAL), allocatable, dimension(:,:,:) :: &
orientation
end type tRGCdependentState
type :: tNumerics_RGC
- real(pReal) :: &
+ real(pREAL) :: &
atol, & !< absolute tolerance of RGC residuum
rtol, & !< relative tolerance of RGC residuum
absMax, & !< absolute maximum of RGC residuum
@@ -108,33 +108,33 @@ module subroutine RGC_init()
num_mechanical => num_homogenization%get_dict('mechanical',defaultVal=emptyDict)
num_RGC => num_mechanical%get_dict('RGC',defaultVal=emptyDict)
- num%atol = num_RGC%get_asFloat('atol', defaultVal=1.0e+4_pReal)
- num%rtol = num_RGC%get_asFloat('rtol', defaultVal=1.0e-3_pReal)
- num%absMax = num_RGC%get_asFloat('amax', defaultVal=1.0e+10_pReal)
- num%relMax = num_RGC%get_asFloat('rmax', defaultVal=1.0e+2_pReal)
- num%pPert = num_RGC%get_asFloat('perturbpenalty', defaultVal=1.0e-7_pReal)
- num%xSmoo = num_RGC%get_asFloat('relvantmismatch', defaultVal=1.0e-5_pReal)
- num%viscPower = num_RGC%get_asFloat('viscositypower', defaultVal=1.0e+0_pReal)
- num%viscModus = num_RGC%get_asFloat('viscositymodulus', defaultVal=0.0e+0_pReal)
- num%refRelaxRate = num_RGC%get_asFloat('refrelaxationrate', defaultVal=1.0e-3_pReal)
- num%maxdRelax = num_RGC%get_asFloat('maxrelaxationrate', defaultVal=1.0e+0_pReal)
- num%maxVolDiscr = num_RGC%get_asFloat('maxvoldiscrepancy', defaultVal=1.0e-5_pReal)
- num%volDiscrMod = num_RGC%get_asFloat('voldiscrepancymod', defaultVal=1.0e+12_pReal)
- num%volDiscrPow = num_RGC%get_asFloat('dicrepancypower', defaultVal=5.0_pReal)
+ num%atol = num_RGC%get_asReal('atol', defaultVal=1.0e+4_pREAL)
+ num%rtol = num_RGC%get_asReal('rtol', defaultVal=1.0e-3_pREAL)
+ num%absMax = num_RGC%get_asReal('amax', defaultVal=1.0e+10_pREAL)
+ num%relMax = num_RGC%get_asReal('rmax', defaultVal=1.0e+2_pREAL)
+ num%pPert = num_RGC%get_asReal('perturbpenalty', defaultVal=1.0e-7_pREAL)
+ num%xSmoo = num_RGC%get_asReal('relvantmismatch', defaultVal=1.0e-5_pREAL)
+ num%viscPower = num_RGC%get_asReal('viscositypower', defaultVal=1.0e+0_pREAL)
+ num%viscModus = num_RGC%get_asReal('viscositymodulus', defaultVal=0.0e+0_pREAL)
+ num%refRelaxRate = num_RGC%get_asReal('refrelaxationrate', defaultVal=1.0e-3_pREAL)
+ num%maxdRelax = num_RGC%get_asReal('maxrelaxationrate', defaultVal=1.0e+0_pREAL)
+ num%maxVolDiscr = num_RGC%get_asReal('maxvoldiscrepancy', defaultVal=1.0e-5_pREAL)
+ num%volDiscrMod = num_RGC%get_asReal('voldiscrepancymod', defaultVal=1.0e+12_pREAL)
+ num%volDiscrPow = num_RGC%get_asReal('dicrepancypower', defaultVal=5.0_pREAL)
- if (num%atol <= 0.0_pReal) call IO_error(301,ext_msg='absTol_RGC')
- if (num%rtol <= 0.0_pReal) call IO_error(301,ext_msg='relTol_RGC')
- if (num%absMax <= 0.0_pReal) call IO_error(301,ext_msg='absMax_RGC')
- if (num%relMax <= 0.0_pReal) call IO_error(301,ext_msg='relMax_RGC')
- if (num%pPert <= 0.0_pReal) call IO_error(301,ext_msg='pPert_RGC')
- if (num%xSmoo <= 0.0_pReal) call IO_error(301,ext_msg='xSmoo_RGC')
- if (num%viscPower < 0.0_pReal) call IO_error(301,ext_msg='viscPower_RGC')
- if (num%viscModus < 0.0_pReal) call IO_error(301,ext_msg='viscModus_RGC')
- if (num%refRelaxRate <= 0.0_pReal) call IO_error(301,ext_msg='refRelaxRate_RGC')
- if (num%maxdRelax <= 0.0_pReal) call IO_error(301,ext_msg='maxdRelax_RGC')
- if (num%maxVolDiscr <= 0.0_pReal) call IO_error(301,ext_msg='maxVolDiscr_RGC')
- if (num%volDiscrMod < 0.0_pReal) call IO_error(301,ext_msg='volDiscrMod_RGC')
- if (num%volDiscrPow <= 0.0_pReal) call IO_error(301,ext_msg='volDiscrPw_RGC')
+ if (num%atol <= 0.0_pREAL) call IO_error(301,ext_msg='absTol_RGC')
+ if (num%rtol <= 0.0_pREAL) call IO_error(301,ext_msg='relTol_RGC')
+ if (num%absMax <= 0.0_pREAL) call IO_error(301,ext_msg='absMax_RGC')
+ if (num%relMax <= 0.0_pREAL) call IO_error(301,ext_msg='relMax_RGC')
+ if (num%pPert <= 0.0_pREAL) call IO_error(301,ext_msg='pPert_RGC')
+ if (num%xSmoo <= 0.0_pREAL) call IO_error(301,ext_msg='xSmoo_RGC')
+ if (num%viscPower < 0.0_pREAL) call IO_error(301,ext_msg='viscPower_RGC')
+ if (num%viscModus < 0.0_pREAL) call IO_error(301,ext_msg='viscModus_RGC')
+ if (num%refRelaxRate <= 0.0_pREAL) call IO_error(301,ext_msg='refRelaxRate_RGC')
+ if (num%maxdRelax <= 0.0_pREAL) call IO_error(301,ext_msg='maxdRelax_RGC')
+ if (num%maxVolDiscr <= 0.0_pREAL) call IO_error(301,ext_msg='maxVolDiscr_RGC')
+ if (num%volDiscrMod < 0.0_pREAL) call IO_error(301,ext_msg='volDiscrMod_RGC')
+ if (num%volDiscrPow <= 0.0_pREAL) call IO_error(301,ext_msg='volDiscrPw_RGC')
do ho = 1, size(mechanical_type)
@@ -147,20 +147,20 @@ module subroutine RGC_init()
dst => dependentState(ho))
#if defined (__GFORTRAN__)
- prm%output = output_as1dString(homogMech)
+ prm%output = output_as1dStr(homogMech)
#else
- prm%output = homogMech%get_as1dString('output',defaultVal=emptyStringArray)
+ prm%output = homogMech%get_as1dStr('output',defaultVal=emptyStrArray)
#endif
prm%N_constituents = homogMech%get_as1dInt('cluster_size',requiredSize=3)
if (homogenization_Nconstituents(ho) /= product(prm%N_constituents)) &
call IO_error(211,ext_msg='N_constituents (RGC)')
- prm%xi_alpha = homogMech%get_asFloat('xi_alpha')
- prm%c_alpha = homogMech%get_asFloat('c_alpha')
+ prm%xi_alpha = homogMech%get_asReal('xi_alpha')
+ prm%c_alpha = homogMech%get_asReal('c_alpha')
- prm%D_alpha = homogMech%get_as1dFloat('D_alpha', requiredSize=3)
- prm%a_g = homogMech%get_as1dFloat('a_g', requiredSize=3)
+ prm%D_alpha = homogMech%get_as1dReal('D_alpha', requiredSize=3)
+ prm%a_g = homogMech%get_as1dReal('a_g', requiredSize=3)
Nmembers = count(material_ID_homogenization == ho)
nIntFaceTot = 3*( (prm%N_constituents(1)-1)*prm%N_constituents(2)*prm%N_constituents(3) &
@@ -169,16 +169,16 @@ module subroutine RGC_init()
sizeState = nIntFaceTot
homogState(ho)%sizeState = sizeState
- allocate(homogState(ho)%state0 (sizeState,Nmembers), source=0.0_pReal)
- allocate(homogState(ho)%state (sizeState,Nmembers), source=0.0_pReal)
+ allocate(homogState(ho)%state0 (sizeState,Nmembers), source=0.0_pREAL)
+ allocate(homogState(ho)%state (sizeState,Nmembers), source=0.0_pREAL)
stt%relaxationVector => homogState(ho)%state(1:nIntFaceTot,:)
st0%relaxationVector => homogState(ho)%state0(1:nIntFaceTot,:)
- allocate(dst%volumeDiscrepancy( Nmembers), source=0.0_pReal)
- allocate(dst%relaxationRate_avg( Nmembers), source=0.0_pReal)
- allocate(dst%relaxationRate_max( Nmembers), source=0.0_pReal)
- allocate(dst%mismatch( 3,Nmembers), source=0.0_pReal)
+ allocate(dst%volumeDiscrepancy( Nmembers), source=0.0_pREAL)
+ allocate(dst%relaxationRate_avg( Nmembers), source=0.0_pREAL)
+ allocate(dst%relaxationRate_max( Nmembers), source=0.0_pREAL)
+ allocate(dst%mismatch( 3,Nmembers), source=0.0_pREAL)
!--------------------------------------------------------------------------------------------------
! assigning cluster orientations
@@ -197,13 +197,13 @@ end subroutine RGC_init
!--------------------------------------------------------------------------------------------------
module subroutine RGC_partitionDeformation(F,avgF,ce)
- real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned F per grain
+ real(pREAL), dimension (:,:,:), intent(out) :: F !< partitioned F per grain
- real(pReal), dimension (3,3), intent(in) :: avgF !< averaged F
+ real(pREAL), dimension (3,3), intent(in) :: avgF !< averaged F
integer, intent(in) :: &
ce
- real(pReal), dimension(3) :: aVect,nVect
+ real(pREAL), dimension(3) :: aVect,nVect
integer, dimension(4) :: intFace
integer, dimension(3) :: iGrain3
integer :: iGrain,iFace,i,j,ho,en
@@ -214,7 +214,7 @@ module subroutine RGC_partitionDeformation(F,avgF,ce)
en = material_entry_homogenization(ce)
!--------------------------------------------------------------------------------------------------
! compute the deformation gradient of individual grains due to relaxations
- F = 0.0_pReal
+ F = 0.0_pREAL
do iGrain = 1,product(prm%N_constituents)
iGrain3 = grain1to3(iGrain,prm%N_constituents)
do iFace = 1,6
@@ -238,25 +238,25 @@ end subroutine RGC_partitionDeformation
!--------------------------------------------------------------------------------------------------
module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
logical, dimension(2) :: doneAndHappy
- real(pReal), dimension(:,:,:), intent(in) :: &
+ real(pREAL), dimension(:,:,:), intent(in) :: &
P,& !< partitioned stresses
F !< partitioned deformation gradients
- real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses
- real(pReal), dimension(3,3), intent(in) :: avgF !< average F
- real(pReal), intent(in) :: dt !< time increment
+ real(pREAL), dimension(:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses
+ real(pREAL), dimension(3,3), intent(in) :: avgF !< average F
+ real(pREAL), intent(in) :: dt !< time increment
integer, intent(in) :: &
ce !< cell
integer, dimension(4) :: intFaceN,intFaceP,faceID
integer, dimension(3) :: nGDim,iGr3N,iGr3P
integer :: ho,iNum,i,j,nIntFaceTot,iGrN,iGrP,iMun,iFace,k,l,ipert,nGrain, en
- real(pReal), dimension(3,3,size(P,3)) :: R,pF,pR,D,pD
- real(pReal), dimension(3,size(P,3)) :: NN,devNull
- real(pReal), dimension(3) :: normP,normN,mornP,mornN
- real(pReal) :: residMax,stresMax
+ real(pREAL), dimension(3,3,size(P,3)) :: R,pF,pR,D,pD
+ real(pREAL), dimension(3,size(P,3)) :: NN,devNull
+ real(pREAL), dimension(3) :: normP,normN,mornP,mornN
+ real(pREAL) :: residMax,stresMax
logical :: error
- real(pReal), dimension(:,:), allocatable :: tract,jmatrix,jnverse,smatrix,pmatrix,rmatrix
- real(pReal), dimension(:), allocatable :: resid,relax,p_relax,p_resid,drelax
+ real(pREAL), dimension(:,:), allocatable :: tract,jmatrix,jnverse,smatrix,pmatrix,rmatrix
+ real(pREAL), dimension(:), allocatable :: resid,relax,p_relax,p_resid,drelax
zeroTimeStep: if (dEq0(dt)) then
doneAndHappy = .true. ! pretend everything is fine and return
@@ -278,8 +278,8 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
!--------------------------------------------------------------------------------------------------
! allocate the size of the global relaxation arrays/jacobian matrices depending on the size of the cluster
- allocate(resid(3*nIntFaceTot), source=0.0_pReal)
- allocate(tract(nIntFaceTot,3), source=0.0_pReal)
+ allocate(resid(3*nIntFaceTot), source=0.0_pREAL)
+ allocate(tract(nIntFaceTot,3), source=0.0_pREAL)
relax = stt%relaxationVector(:,en)
drelax = stt%relaxationVector(:,en) - st0%relaxationVector(:,en)
@@ -337,8 +337,8 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
if (residMax < num%rtol*stresMax .or. residMax < num%atol) then
doneAndHappy = .true.
- dst%mismatch(1:3,en) = sum(NN,2)/real(nGrain,pReal)
- dst%relaxationRate_avg(en) = sum(abs(drelax))/dt/real(3*nIntFaceTot,pReal)
+ dst%mismatch(1:3,en) = sum(NN,2)/real(nGrain,pREAL)
+ dst%relaxationRate_avg(en) = sum(abs(drelax))/dt/real(3*nIntFaceTot,pREAL)
dst%relaxationRate_max(en) = maxval(abs(drelax))/dt
return
@@ -356,7 +356,7 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
!--------------------------------------------------------------------------------------------------
! ... of the constitutive stress tangent, assembled from dPdF or material constitutive model "smatrix"
- allocate(smatrix(3*nIntFaceTot,3*nIntFaceTot), source=0.0_pReal)
+ allocate(smatrix(3*nIntFaceTot,3*nIntFaceTot), source=0.0_pREAL)
do iNum = 1,nIntFaceTot
faceID = interface1to4(iNum,param(ho)%N_constituents) ! assembling of local dPdF into global Jacobian matrix
@@ -403,9 +403,9 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
!--------------------------------------------------------------------------------------------------
! ... of the stress penalty tangent (mismatch penalty and volume penalty, computed using numerical
! perturbation method) "pmatrix"
- allocate(pmatrix(3*nIntFaceTot,3*nIntFaceTot), source=0.0_pReal)
- allocate(p_relax(3*nIntFaceTot), source=0.0_pReal)
- allocate(p_resid(3*nIntFaceTot), source=0.0_pReal)
+ allocate(pmatrix(3*nIntFaceTot,3*nIntFaceTot), source=0.0_pREAL)
+ allocate(p_relax(3*nIntFaceTot), source=0.0_pREAL)
+ allocate(p_resid(3*nIntFaceTot), source=0.0_pREAL)
do ipert = 1,3*nIntFaceTot
p_relax = relax
@@ -417,7 +417,7 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
!--------------------------------------------------------------------------------------------------
! computing the global stress residual array from the perturbed state
- p_resid = 0.0_pReal
+ p_resid = 0.0_pREAL
do iNum = 1,nIntFaceTot
faceID = interface1to4(iNum,param(ho)%N_constituents) ! identifying the interface ID in local coordinate system (4-dimensional index)
@@ -452,10 +452,10 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
!--------------------------------------------------------------------------------------------------
! ... of the numerical viscosity traction "rmatrix"
- allocate(rmatrix(3*nIntFaceTot,3*nIntFaceTot),source=0.0_pReal)
+ allocate(rmatrix(3*nIntFaceTot,3*nIntFaceTot),source=0.0_pREAL)
do i=1,3*nIntFaceTot
rmatrix(i,i) = num%viscModus*num%viscPower/(num%refRelaxRate*dt)* & ! tangent due to numerical viscosity traction appears
- (abs(drelax(i))/(num%refRelaxRate*dt))**(num%viscPower - 1.0_pReal) ! only in the main diagonal term
+ (abs(drelax(i))/(num%refRelaxRate*dt))**(num%viscPower - 1.0_pREAL) ! only in the main diagonal term
end do
@@ -465,12 +465,12 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
!--------------------------------------------------------------------------------------------------
! computing the update of the state variable (relaxation vectors) using the Jacobian matrix
- allocate(jnverse(3*nIntFaceTot,3*nIntFaceTot),source=0.0_pReal)
+ allocate(jnverse(3*nIntFaceTot,3*nIntFaceTot),source=0.0_pREAL)
call math_invert(jnverse,error,jmatrix)
!--------------------------------------------------------------------------------------------------
! calculate the state update (global relaxation vectors) for the next Newton-Raphson iteration
- drelax = 0.0_pReal
+ drelax = 0.0_pREAL
do i = 1,3*nIntFaceTot;do j = 1,3*nIntFaceTot
drelax(i) = drelax(i) - jnverse(i,j)*resid(j) ! Calculate the correction for the state variable
end do; end do
@@ -492,26 +492,26 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
!------------------------------------------------------------------------------------------------
subroutine stressPenalty(rPen,nMis,avgF,fDef,ho,en)
- real(pReal), dimension (:,:,:), intent(out) :: rPen !< stress-like penalty
- real(pReal), dimension (:,:), intent(out) :: nMis !< total amount of mismatch
+ real(pREAL), dimension (:,:,:), intent(out) :: rPen !< stress-like penalty
+ real(pREAL), dimension (:,:), intent(out) :: nMis !< total amount of mismatch
- real(pReal), dimension (:,:,:), intent(in) :: fDef !< deformation gradients
- real(pReal), dimension (3,3), intent(in) :: avgF !< initial effective stretch tensor
+ real(pREAL), dimension (:,:,:), intent(in) :: fDef !< deformation gradients
+ real(pREAL), dimension (3,3), intent(in) :: avgF !< initial effective stretch tensor
integer, intent(in) :: ho, en
integer, dimension (4) :: intFace
integer, dimension (3) :: iGrain3,iGNghb3,nGDim
- real(pReal), dimension (3,3) :: gDef,nDef
- real(pReal), dimension (3) :: nVect,surfCorr
+ real(pREAL), dimension (3,3) :: gDef,nDef
+ real(pREAL), dimension (3) :: nVect,surfCorr
integer :: iGrain,iGNghb,iFace,i,j,k,l
- real(pReal) :: muGrain,muGNghb,nDefNorm
- real(pReal), parameter :: &
- nDefToler = 1.0e-10_pReal, &
- b = 2.5e-10_pReal ! Length of Burgers vector
+ real(pREAL) :: muGrain,muGNghb,nDefNorm
+ real(pREAL), parameter :: &
+ nDefToler = 1.0e-10_pREAL, &
+ b = 2.5e-10_pREAL ! Length of Burgers vector
nGDim = param(ho)%N_constituents
- rPen = 0.0_pReal
- nMis = 0.0_pReal
+ rPen = 0.0_pREAL
+ nMis = 0.0_pREAL
!----------------------------------------------------------------------------------------------
! get the correction factor the modulus of penalty stress representing the evolution of area of
@@ -532,17 +532,17 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
nVect = interfaceNormal(intFace,ho,en)
iGNghb3 = iGrain3 ! identify the neighboring grain across the interface
iGNghb3(abs(intFace(1))) = iGNghb3(abs(intFace(1))) &
- + int(real(intFace(1),pReal)/real(abs(intFace(1)),pReal))
+ + int(real(intFace(1),pREAL)/real(abs(intFace(1)),pREAL))
where(iGNghb3 < 1) iGNghb3 = nGDim
where(iGNghb3 >nGDim) iGNghb3 = 1
iGNghb = grain3to1(iGNghb3,prm%N_constituents) ! get the ID of the neighboring grain
muGNghb = equivalentMu(iGNghb,ce)
- gDef = 0.5_pReal*(fDef(1:3,1:3,iGNghb) - fDef(1:3,1:3,iGrain)) ! difference/jump in deformation gradeint across the neighbor
+ gDef = 0.5_pREAL*(fDef(1:3,1:3,iGNghb) - fDef(1:3,1:3,iGrain)) ! difference/jump in deformation gradeint across the neighbor
!-------------------------------------------------------------------------------------------
! compute the mismatch tensor of all interfaces
- nDefNorm = 0.0_pReal
- nDef = 0.0_pReal
+ nDefNorm = 0.0_pREAL
+ nDef = 0.0_pREAL
do i = 1,3; do j = 1,3
do k = 1,3; do l = 1,3
nDef(i,j) = nDef(i,j) - nVect(k)*gDef(i,l)*math_LeviCivita(j,k,l) ! compute the interface mismatch tensor from the jump of deformation gradient
@@ -556,10 +556,10 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
!-------------------------------------------------------------------------------------------
! compute the stress penalty of all interfaces
do i = 1,3; do j = 1,3; do k = 1,3; do l = 1,3
- rPen(i,j,iGrain) = rPen(i,j,iGrain) + 0.5_pReal*(muGrain*b + muGNghb*b)*prm%xi_alpha &
+ rPen(i,j,iGrain) = rPen(i,j,iGrain) + 0.5_pREAL*(muGrain*b + muGNghb*b)*prm%xi_alpha &
*surfCorr(abs(intFace(1)))/prm%D_alpha(abs(intFace(1))) &
*cosh(prm%c_alpha*nDefNorm) &
- *0.5_pReal*nVect(l)*nDef(i,k)/nDefNorm*math_LeviCivita(k,l,j) &
+ *0.5_pREAL*nVect(l)*nDef(i,k)/nDefNorm*math_LeviCivita(k,l,j) &
*tanh(nDefNorm/num%xSmoo)
end do; end do;end do; end do
end do interfaceLoop
@@ -577,15 +577,15 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
!------------------------------------------------------------------------------------------------
subroutine volumePenalty(vPen,vDiscrep,fAvg,fDef,nGrain)
- real(pReal), dimension (:,:,:), intent(out) :: vPen ! stress-like penalty due to volume
- real(pReal), intent(out) :: vDiscrep ! total volume discrepancy
+ real(pREAL), dimension (:,:,:), intent(out) :: vPen ! stress-like penalty due to volume
+ real(pREAL), intent(out) :: vDiscrep ! total volume discrepancy
- real(pReal), dimension (:,:,:), intent(in) :: fDef ! deformation gradients
- real(pReal), dimension (3,3), intent(in) :: fAvg ! overall deformation gradient
+ real(pREAL), dimension (:,:,:), intent(in) :: fDef ! deformation gradients
+ real(pREAL), dimension (3,3), intent(in) :: fAvg ! overall deformation gradient
integer, intent(in) :: &
Ngrain
- real(pReal), dimension(size(vPen,3)) :: gVol
+ real(pREAL), dimension(size(vPen,3)) :: gVol
integer :: i
!----------------------------------------------------------------------------------------------
@@ -593,16 +593,16 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
vDiscrep = math_det33(fAvg) ! compute the volume of the cluster
do i = 1,nGrain
gVol(i) = math_det33(fDef(1:3,1:3,i)) ! compute the volume of individual grains
- vDiscrep = vDiscrep - gVol(i)/real(nGrain,pReal) ! calculate the difference/dicrepancy between
+ vDiscrep = vDiscrep - gVol(i)/real(nGrain,pREAL) ! calculate the difference/dicrepancy between
! the volume of the cluster and the the total volume of grains
end do
!----------------------------------------------------------------------------------------------
! calculate the stress and penalty due to volume discrepancy
- vPen = 0.0_pReal
+ vPen = 0.0_pREAL
do i = 1,nGrain
- vPen(:,:,i) = -real(nGrain,pReal)**(-1)*num%volDiscrMod*num%volDiscrPow/num%maxVolDiscr &
- * sign((abs(vDiscrep)/num%maxVolDiscr)**(num%volDiscrPow - 1.0_pReal),vDiscrep) &
+ vPen(:,:,i) = -real(nGrain,pREAL)**(-1)*num%volDiscrMod*num%volDiscrPow/num%maxVolDiscr &
+ * sign((abs(vDiscrep)/num%maxVolDiscr)**(num%volDiscrPow - 1.0_pREAL),vDiscrep) &
* gVol(i)*transpose(math_inv33(fDef(:,:,i)))
end do
@@ -615,21 +615,21 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
!--------------------------------------------------------------------------------------------------
function surfaceCorrection(avgF,ho,en)
- real(pReal), dimension(3) :: surfaceCorrection
+ real(pREAL), dimension(3) :: surfaceCorrection
- real(pReal), dimension(3,3), intent(in) :: avgF !< average F
+ real(pREAL), dimension(3,3), intent(in) :: avgF !< average F
integer, intent(in) :: &
ho, &
en
- real(pReal), dimension(3,3) :: invC
- real(pReal), dimension(3) :: nVect
- real(pReal) :: detF
+ real(pREAL), dimension(3,3) :: invC
+ real(pREAL), dimension(3) :: nVect
+ real(pREAL) :: detF
integer :: i,j,iBase
logical :: error
call math_invert33(invC,detF,error,matmul(transpose(avgF),avgF))
- surfaceCorrection = 0.0_pReal
+ surfaceCorrection = 0.0_pREAL
do iBase = 1,3
nVect = interfaceNormal([iBase,1,1,1],ho,en)
do i = 1,3; do j = 1,3
@@ -644,13 +644,13 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
!-------------------------------------------------------------------------------------------------
!> @brief compute the equivalent shear and bulk moduli from the elasticity tensor
!-------------------------------------------------------------------------------------------------
- real(pReal) function equivalentMu(co,ce)
+ real(pREAL) function equivalentMu(co,ce)
integer, intent(in) :: &
co,&
ce
- real(pReal), dimension(6,6) :: C
+ real(pREAL), dimension(6,6) :: C
C = phase_homogenizedC66(material_ID_phase(co,ce),material_entry_phase(co,ce)) ! damage not included!
@@ -665,14 +665,14 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
!-------------------------------------------------------------------------------------------------
subroutine grainDeformation(F, avgF, ho, en)
- real(pReal), dimension(:,:,:), intent(out) :: F !< partitioned F per grain
+ real(pREAL), dimension(:,:,:), intent(out) :: F !< partitioned F per grain
- real(pReal), dimension(:,:), intent(in) :: avgF !< averaged F
+ real(pREAL), dimension(:,:), intent(in) :: avgF !< averaged F
integer, intent(in) :: &
ho, &
en
- real(pReal), dimension(3) :: aVect,nVect
+ real(pREAL), dimension(3) :: aVect,nVect
integer, dimension(4) :: intFace
integer, dimension(3) :: iGrain3
integer :: iGrain,iFace,i,j
@@ -682,7 +682,7 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
associate (prm => param(ho))
- F = 0.0_pReal
+ F = 0.0_pREAL
do iGrain = 1,product(prm%N_constituents)
iGrain3 = grain1to3(iGrain,prm%N_constituents)
do iFace = 1,6
@@ -739,7 +739,7 @@ end subroutine RGC_result
!--------------------------------------------------------------------------------------------------
pure function relaxationVector(intFace,ho,en)
- real(pReal), dimension (3) :: relaxationVector
+ real(pREAL), dimension (3) :: relaxationVector
integer, intent(in) :: ho,en
integer, dimension(4), intent(in) :: intFace !< set of interface ID in 4D array (normal and position)
@@ -756,7 +756,7 @@ pure function relaxationVector(intFace,ho,en)
if (iNum > 0) then
relaxationVector = stt%relaxationVector((3*iNum-2):(3*iNum),en)
else
- relaxationVector = 0.0_pReal
+ relaxationVector = 0.0_pREAL
end if
end associate
@@ -769,7 +769,7 @@ end function relaxationVector
!--------------------------------------------------------------------------------------------------
pure function interfaceNormal(intFace,ho,en) result(n)
- real(pReal), dimension(3) :: n
+ real(pREAL), dimension(3) :: n
integer, dimension(4), intent(in) :: intFace !< interface ID in 4D array (normal and position)
integer, intent(in) :: &
ho, &
@@ -778,8 +778,8 @@ pure function interfaceNormal(intFace,ho,en) result(n)
associate (dst => dependentState(ho))
- n = 0.0_pReal
- n(abs(intFace(1))) = real(intFace(1)/abs(intFace(1)),pReal) ! get the normal vector w.r.t. cluster axis
+ n = 0.0_pREAL
+ n(abs(intFace(1))) = real(intFace(1)/abs(intFace(1)),pREAL) ! get the normal vector w.r.t. cluster axis
n = matmul(dst%orientation(1:3,1:3,en),n) ! map the normal vector into sample coordinate system (basis)
@@ -800,7 +800,7 @@ pure function getInterface(iFace,iGrain3) result(i)
integer :: iDir !< direction of interface normal
- iDir = (int(real(iFace-1,pReal)/2.0_pReal)+1)*(-1)**iFace
+ iDir = (int(real(iFace-1,pREAL)/2.0_pREAL)+1)*(-1)**iFace
i = [iDir,iGrain3]
if (iDir < 0) i(1-iDir) = i(1-iDir)-1 ! to have a correlation with coordinate/position in real space
@@ -907,18 +907,18 @@ pure function interface1to4(iFace1D, nGDim)
if (iFace1D > 0 .and. iFace1D <= nIntFace(1)) then ! interface with normal || e1
interface1to4(1) = 1
interface1to4(3) = mod((iFace1D-1),nGDim(2))+1
- interface1to4(4) = mod(int(real(iFace1D-1,pReal)/real(nGDim(2),pReal)),nGDim(3))+1
- interface1to4(2) = int(real(iFace1D-1,pReal)/real(nGDim(2),pReal)/real(nGDim(3),pReal))+1
+ interface1to4(4) = mod(int(real(iFace1D-1,pREAL)/real(nGDim(2),pREAL)),nGDim(3))+1
+ interface1to4(2) = int(real(iFace1D-1,pREAL)/real(nGDim(2),pREAL)/real(nGDim(3),pREAL))+1
elseif (iFace1D > nIntFace(1) .and. iFace1D <= (nIntFace(2) + nIntFace(1))) then ! interface with normal || e2
interface1to4(1) = 2
interface1to4(4) = mod((iFace1D-nIntFace(1)-1),nGDim(3))+1
- interface1to4(2) = mod(int(real(iFace1D-nIntFace(1)-1,pReal)/real(nGDim(3),pReal)),nGDim(1))+1
- interface1to4(3) = int(real(iFace1D-nIntFace(1)-1,pReal)/real(nGDim(3),pReal)/real(nGDim(1),pReal))+1
+ interface1to4(2) = mod(int(real(iFace1D-nIntFace(1)-1,pREAL)/real(nGDim(3),pREAL)),nGDim(1))+1
+ interface1to4(3) = int(real(iFace1D-nIntFace(1)-1,pREAL)/real(nGDim(3),pREAL)/real(nGDim(1),pREAL))+1
elseif (iFace1D > nIntFace(2) + nIntFace(1) .and. iFace1D <= (nIntFace(3) + nIntFace(2) + nIntFace(1))) then ! interface with normal || e3
interface1to4(1) = 3
interface1to4(2) = mod((iFace1D-nIntFace(2)-nIntFace(1)-1),nGDim(1))+1
- interface1to4(3) = mod(int(real(iFace1D-nIntFace(2)-nIntFace(1)-1,pReal)/real(nGDim(1),pReal)),nGDim(2))+1
- interface1to4(4) = int(real(iFace1D-nIntFace(2)-nIntFace(1)-1,pReal)/real(nGDim(1),pReal)/real(nGDim(2),pReal))+1
+ interface1to4(3) = mod(int(real(iFace1D-nIntFace(2)-nIntFace(1)-1,pREAL)/real(nGDim(1),pREAL)),nGDim(2))+1
+ interface1to4(4) = int(real(iFace1D-nIntFace(2)-nIntFace(1)-1,pREAL)/real(nGDim(1),pREAL)/real(nGDim(2),pREAL))+1
end if
end function interface1to4
diff --git a/src/homogenization_mechanical_isostrain.f90 b/src/homogenization_mechanical_isostrain.f90
index 3a603196f..a3807cb87 100644
--- a/src/homogenization_mechanical_isostrain.f90
+++ b/src/homogenization_mechanical_isostrain.f90
@@ -40,9 +40,9 @@ end subroutine isostrain_init
!--------------------------------------------------------------------------------------------------
module subroutine isostrain_partitionDeformation(F,avgF)
- real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient
+ real(pREAL), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient
- real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point
+ real(pREAL), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point
F = spread(avgF,3,size(F,3))
diff --git a/src/homogenization_thermal.f90 b/src/homogenization_thermal.f90
index edba596c8..789ac994b 100644
--- a/src/homogenization_thermal.f90
+++ b/src/homogenization_thermal.f90
@@ -14,13 +14,13 @@ submodule(homogenization) thermal
end interface
type :: tDataContainer
- real(pReal), dimension(:), allocatable :: T, dot_T
+ real(pREAL), dimension(:), allocatable :: T, dot_T
end type tDataContainer
type(tDataContainer), dimension(:), allocatable :: current
type :: tParameters
- character(len=pStringLen), allocatable, dimension(:) :: &
+ character(len=pSTRLEN), allocatable, dimension(:) :: &
output
end type tParameters
@@ -51,18 +51,18 @@ module subroutine thermal_init()
do ho = 1, configHomogenizations%length
allocate(current(ho)%T(count(material_ID_homogenization==ho)), source=T_ROOM)
- allocate(current(ho)%dot_T(count(material_ID_homogenization==ho)), source=0.0_pReal)
+ allocate(current(ho)%dot_T(count(material_ID_homogenization==ho)), source=0.0_pREAL)
configHomogenization => configHomogenizations%get_dict(ho)
associate(prm => param(ho))
if (configHomogenization%contains('thermal')) then
configHomogenizationThermal => configHomogenization%get_dict('thermal')
#if defined (__GFORTRAN__)
- prm%output = output_as1dString(configHomogenizationThermal)
+ prm%output = output_as1dStr(configHomogenizationThermal)
#else
- prm%output = configHomogenizationThermal%get_as1dString('output',defaultVal=emptyStringArray)
+ prm%output = configHomogenizationThermal%get_as1dStr('output',defaultVal=emptyStrArray)
#endif
- select case (configHomogenizationThermal%get_asString('type'))
+ select case (configHomogenizationThermal%get_asStr('type'))
case ('pass')
call pass_init()
@@ -72,7 +72,7 @@ module subroutine thermal_init()
end select
else
- prm%output = emptyStringArray
+ prm%output = emptyStrArray
end if
end associate
@@ -100,7 +100,7 @@ module subroutine thermal_partition(ce)
integer, intent(in) :: ce
- real(pReal) :: T, dot_T
+ real(pREAL) :: T, dot_T
integer :: co
@@ -119,7 +119,7 @@ end subroutine thermal_partition
module function homogenization_mu_T(ce) result(mu)
integer, intent(in) :: ce
- real(pReal) :: mu
+ real(pREAL) :: mu
integer :: co
@@ -138,7 +138,7 @@ end function homogenization_mu_T
module function homogenization_K_T(ce) result(K)
integer, intent(in) :: ce
- real(pReal), dimension(3,3) :: K
+ real(pREAL), dimension(3,3) :: K
integer :: co
@@ -157,7 +157,7 @@ end function homogenization_K_T
module function homogenization_f_T(ce) result(f)
integer, intent(in) :: ce
- real(pReal) :: f
+ real(pREAL) :: f
integer :: co
@@ -176,7 +176,7 @@ end function homogenization_f_T
module subroutine homogenization_thermal_setField(T,dot_T, ce)
integer, intent(in) :: ce
- real(pReal), intent(in) :: T, dot_T
+ real(pREAL), intent(in) :: T, dot_T
current(material_ID_homogenization(ce))%T(material_entry_homogenization(ce)) = T
diff --git a/src/lattice.f90 b/src/lattice.f90
index 5cb254012..350860ecb 100644
--- a/src/lattice.f90
+++ b/src/lattice.f90
@@ -38,7 +38,7 @@ module lattice
CF_NTRANS = sum(CF_NTRANSSYSTEM), & !< total # of transformation systems for cF
CF_NCLEAVAGE = sum(CF_NCLEAVAGESYSTEM) !< total # of cleavage systems for cF
- real(pReal), dimension(3+3,CF_NSLIP), parameter :: &
+ real(pREAL), dimension(3+3,CF_NSLIP), parameter :: &
CF_SYSTEMSLIP = reshape(real([&
! <110>{111} systems
0, 1,-1, 1, 1, 1, & ! B2
@@ -60,9 +60,9 @@ module lattice
1, 0,-1, 1, 0, 1, &
0, 1, 1, 0, 1,-1, &
0, 1,-1, 0, 1, 1 &
- ],pReal),shape(CF_SYSTEMSLIP)) !< cF slip systems
+ ],pREAL),shape(CF_SYSTEMSLIP)) !< cF slip systems
- real(pReal), dimension(3+3,CF_NTWIN), parameter :: &
+ real(pREAL), dimension(3+3,CF_NTWIN), parameter :: &
CF_SYSTEMTWIN = reshape(real( [&
! <112>{111} systems
-2, 1, 1, 1, 1, 1, &
@@ -77,7 +77,7 @@ module lattice
2, 1,-1, -1, 1,-1, &
-1,-2,-1, -1, 1,-1, &
-1, 1, 2, -1, 1,-1 &
- ],pReal),shape(CF_SYSTEMTWIN)) !< cF twin systems
+ ],pREAL),shape(CF_SYSTEMTWIN)) !< cF twin systems
integer, dimension(2,CF_NTWIN), parameter, public :: &
lattice_CF_TWINNUCLEATIONSLIPPAIR = reshape( [&
@@ -95,13 +95,13 @@ module lattice
10,11 &
],shape(lattice_CF_TWINNUCLEATIONSLIPPAIR))
- real(pReal), dimension(3+3,CF_NCLEAVAGE), parameter :: &
+ real(pREAL), dimension(3+3,CF_NCLEAVAGE), parameter :: &
CF_SYSTEMCLEAVAGE = reshape(real([&
! <001>{001} systems
0, 1, 0, 1, 0, 0, &
0, 0, 1, 0, 1, 0, &
1, 0, 0, 0, 0, 1 &
- ],pReal),shape(CF_SYSTEMCLEAVAGE)) !< cF cleavage systems
+ ],pREAL),shape(CF_SYSTEMCLEAVAGE)) !< cF cleavage systems
!--------------------------------------------------------------------------------------------------
! cI: body centered cubic (bcc)
@@ -120,7 +120,7 @@ module lattice
CI_NTWIN = sum(CI_NTWINSYSTEM), & !< total # of twin systems for cI
CI_NCLEAVAGE = sum(CI_NCLEAVAGESYSTEM) !< total # of cleavage systems for cI
- real(pReal), dimension(3+3,CI_NSLIP), parameter :: &
+ real(pREAL), dimension(3+3,CI_NSLIP), parameter :: &
CI_SYSTEMSLIP = reshape(real([&
! <111>{110} systems
1,-1, 1, 0, 1, 1, & ! D1
@@ -173,9 +173,9 @@ module lattice
1, 1, 1, -3, 2, 1, &
1, 1,-1, 3,-2, 1, &
1,-1, 1, 3, 2,-1 &
- ],pReal),shape(CI_SYSTEMSLIP)) !< cI slip systems
+ ],pREAL),shape(CI_SYSTEMSLIP)) !< cI slip systems
- real(pReal), dimension(3+3,CI_NTWIN), parameter :: &
+ real(pREAL), dimension(3+3,CI_NTWIN), parameter :: &
CI_SYSTEMTWIN = reshape(real([&
! <111>{112} systems
-1, 1, 1, 2, 1, 1, &
@@ -190,15 +190,15 @@ module lattice
1,-1, 1, -1, 1, 2, &
-1, 1, 1, 1,-1, 2, &
1, 1, 1, 1, 1,-2 &
- ],pReal),shape(CI_SYSTEMTWIN)) !< cI twin systems
+ ],pREAL),shape(CI_SYSTEMTWIN)) !< cI twin systems
- real(pReal), dimension(3+3,CI_NCLEAVAGE), parameter :: &
+ real(pREAL), dimension(3+3,CI_NCLEAVAGE), parameter :: &
CI_SYSTEMCLEAVAGE = reshape(real([&
! <001>{001} systems
0, 1, 0, 1, 0, 0, &
0, 0, 1, 0, 1, 0, &
1, 0, 0, 0, 0, 1 &
- ],pReal),shape(CI_SYSTEMCLEAVAGE)) !< cI cleavage systems
+ ],pREAL),shape(CI_SYSTEMCLEAVAGE)) !< cI cleavage systems
!--------------------------------------------------------------------------------------------------
! hP: hexagonal [close packed] (hex, hcp)
@@ -213,7 +213,7 @@ module lattice
HP_NSLIP = sum(HP_NSLIPSYSTEM), & !< total # of slip systems for hP
HP_NTWIN = sum(HP_NTWINSYSTEM) !< total # of twin systems for hP
- real(pReal), dimension(4+4,HP_NSLIP), parameter :: &
+ real(pREAL), dimension(4+4,HP_NSLIP), parameter :: &
HP_SYSTEMSLIP = reshape(real([&
! <-1-1.0>{00.1}/basal systems (independent of c/a-ratio)
2, -1, -1, 0, 0, 0, 0, 1, &
@@ -250,9 +250,9 @@ module lattice
1, 1, -2, 3, -1, -1, 2, 2, &
-1, 2, -1, 3, 1, -2, 1, 2, &
-2, 1, 1, 3, 2, -1, -1, 2 &
- ],pReal),shape(HP_SYSTEMSLIP)) !< hP slip systems, sorted by P. Eisenlohr CCW around starting next to a_1 axis
+ ],pREAL),shape(HP_SYSTEMSLIP)) !< hP slip systems, sorted by P. Eisenlohr CCW around starting next to a_1 axis
- real(pReal), dimension(4+4,HP_NTWIN), parameter :: &
+ real(pREAL), dimension(4+4,HP_NTWIN), parameter :: &
HP_SYSTEMTWIN = reshape(real([&
! <-10.1>{10.2} systems, shear = (3-(c/a)^2)/(sqrt(3) c/a)
! tension in Co, Mg, Zr, Ti, and Be; compression in Cd and Zn
@@ -286,7 +286,7 @@ module lattice
-1, -1, 2, -3, -1, -1, 2, 2, &
1, -2, 1, -3, 1, -2, 1, 2, &
2, -1, -1, -3, 2, -1, -1, 2 &
- ],pReal),shape(HP_SYSTEMTWIN)) !< hP twin systems, sorted by P. Eisenlohr CCW around starting next to a_1 axis
+ ],pREAL),shape(HP_SYSTEMTWIN)) !< hP twin systems, sorted by P. Eisenlohr CCW around starting next to a_1 axis
!--------------------------------------------------------------------------------------------------
! tI: body centered tetragonal (bct)
@@ -297,7 +297,7 @@ module lattice
integer, parameter :: &
TI_NSLIP = sum(TI_NSLIPSYSTEM) !< total # of slip systems for tI
- real(pReal), dimension(3+3,TI_NSLIP), parameter :: &
+ real(pREAL), dimension(3+3,TI_NSLIP), parameter :: &
TI_SYSTEMSLIP = reshape(real([&
! {100)<001] systems
0, 0, 1, 1, 0, 0, &
@@ -364,7 +364,7 @@ module lattice
1,-1, 1, -2,-1, 1, &
-1, 1, 1, -1,-2, 1, &
1, 1, 1, 1,-2, 1 &
- ],pReal),shape(TI_SYSTEMSLIP)) !< tI slip systems for c/a = 0.5456 (Sn), sorted by Bieler 2009 (https://doi.org/10.1007/s11664-009-0909-x)
+ ],pREAL),shape(TI_SYSTEMSLIP)) !< tI slip systems for c/a = 0.5456 (Sn), sorted by Bieler 2009 (https://doi.org/10.1007/s11664-009-0909-x)
interface lattice_forestProjection_edge
@@ -424,8 +424,8 @@ function lattice_characteristicShear_Twin(Ntwin,lattice,CoverA) result(character
integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
- real(pReal), intent(in) :: cOverA !< c/a ratio
- real(pReal), dimension(sum(Ntwin)) :: characteristicShear
+ real(pREAL), intent(in) :: cOverA !< c/a ratio
+ real(pREAL), dimension(sum(Ntwin)) :: characteristicShear
integer :: &
a, & !< index of active system
@@ -467,20 +467,20 @@ function lattice_characteristicShear_Twin(Ntwin,lattice,CoverA) result(character
a = a + 1
select case(lattice)
case('cF','cI')
- characteristicShear(a) = 0.5_pReal*sqrt(2.0_pReal)
+ characteristicShear(a) = 0.5_pREAL*sqrt(2.0_pREAL)
case('hP')
- if (cOverA < 1.0_pReal .or. cOverA > 2.0_pReal) &
+ if (cOverA < 1.0_pREAL .or. cOverA > 2.0_pREAL) &
call IO_error(131,ext_msg='lattice_characteristicShear_Twin')
p = sum(HP_NTWINSYSTEM(1:f-1))+s
select case(HP_SHEARTWIN(p)) ! from Christian & Mahajan 1995 p.29
case (1) ! <-10.1>{10.2}
- characteristicShear(a) = (3.0_pReal-cOverA**2)/sqrt(3.0_pReal)/CoverA
+ characteristicShear(a) = (3.0_pREAL-cOverA**2)/sqrt(3.0_pREAL)/CoverA
case (2) ! <11.6>{-1-1.1}
- characteristicShear(a) = 1.0_pReal/cOverA
+ characteristicShear(a) = 1.0_pREAL/cOverA
case (3) ! <10.-2>{10.1}
- characteristicShear(a) = (4.0_pReal*cOverA**2-9.0_pReal)/sqrt(48.0_pReal)/cOverA
+ characteristicShear(a) = (4.0_pREAL*cOverA**2-9.0_pREAL)/sqrt(48.0_pREAL)/cOverA
case (4) ! <11.-3>{11.2}
- characteristicShear(a) = 2.0_pReal*(cOverA**2-2.0_pReal)/3.0_pReal/cOverA
+ characteristicShear(a) = 2.0_pREAL*(cOverA**2-2.0_pREAL)/3.0_pREAL/cOverA
end select
case default
call IO_error(137,ext_msg='lattice_characteristicShear_Twin: '//trim(lattice))
@@ -498,11 +498,11 @@ function lattice_C66_twin(Ntwin,C66,lattice,CoverA)
integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
- real(pReal), dimension(6,6), intent(in) :: C66 !< unrotated parent stiffness matrix
- real(pReal), intent(in) :: cOverA !< c/a ratio
- real(pReal), dimension(6,6,sum(Ntwin)) :: lattice_C66_twin
+ real(pREAL), dimension(6,6), intent(in) :: C66 !< unrotated parent stiffness matrix
+ real(pREAL), intent(in) :: cOverA !< c/a ratio
+ real(pREAL), dimension(6,6,sum(Ntwin)) :: lattice_C66_twin
- real(pReal), dimension(3,3,sum(Ntwin)):: coordinateSystem
+ real(pREAL), dimension(3,3,sum(Ntwin)):: coordinateSystem
type(tRotation) :: R
integer :: i
@@ -510,10 +510,10 @@ function lattice_C66_twin(Ntwin,C66,lattice,CoverA)
select case(lattice)
case('cF')
coordinateSystem = buildCoordinateSystem(Ntwin,CF_NSLIPSYSTEM,CF_SYSTEMTWIN,&
- lattice,0.0_pReal)
+ lattice,0.0_pREAL)
case('cI')
coordinateSystem = buildCoordinateSystem(Ntwin,CI_NSLIPSYSTEM,CI_SYSTEMTWIN,&
- lattice,0.0_pReal)
+ lattice,0.0_pREAL)
case('hP')
coordinateSystem = buildCoordinateSystem(Ntwin,HP_NSLIPSYSTEM,HP_SYSTEMTWIN,&
lattice,cOverA)
@@ -537,12 +537,12 @@ function lattice_C66_trans(Ntrans,C_parent66,lattice_target, &
integer, dimension(:), intent(in) :: Ntrans !< number of active twin systems per family
character(len=*), intent(in) :: lattice_target !< Bravais lattice (Pearson symbol)
- real(pReal), dimension(6,6), intent(in) :: C_parent66
- real(pReal), optional, intent(in) :: cOverA_trans, a_cF, a_cI
- real(pReal), dimension(6,6,sum(Ntrans)) :: lattice_C66_trans
+ real(pREAL), dimension(6,6), intent(in) :: C_parent66
+ real(pREAL), optional, intent(in) :: cOverA_trans, a_cF, a_cI
+ real(pREAL), dimension(6,6,sum(Ntrans)) :: lattice_C66_trans
- real(pReal), dimension(6,6) :: C_bar66, C_target_unrotated66
- real(pReal), dimension(3,3,sum(Ntrans)) :: Q,S
+ real(pREAL), dimension(6,6) :: C_bar66, C_target_unrotated66
+ real(pREAL), dimension(3,3,sum(Ntrans)) :: Q,S
type(tRotation) :: R
integer :: i
@@ -551,24 +551,24 @@ function lattice_C66_trans(Ntrans,C_parent66,lattice_target, &
if (lattice_target == 'hP' .and. present(cOverA_trans)) then
! https://doi.org/10.1063/1.1663858 eq. (16), eq. (18), eq. (19)
! https://doi.org/10.1016/j.actamat.2016.07.032 eq. (47), eq. (48)
- if (cOverA_trans < 1.0_pReal .or. cOverA_trans > 2.0_pReal) &
+ if (cOverA_trans < 1.0_pREAL .or. cOverA_trans > 2.0_pREAL) &
call IO_error(131,ext_msg='lattice_C66_trans: '//trim(lattice_target))
- C_bar66(1,1) = (C_parent66(1,1) + C_parent66(1,2) + 2.0_pReal*C_parent66(4,4))/2.0_pReal
- C_bar66(1,2) = (C_parent66(1,1) + 5.0_pReal*C_parent66(1,2) - 2.0_pReal*C_parent66(4,4))/6.0_pReal
- C_bar66(3,3) = (C_parent66(1,1) + 2.0_pReal*C_parent66(1,2) + 4.0_pReal*C_parent66(4,4))/3.0_pReal
- C_bar66(1,3) = (C_parent66(1,1) + 2.0_pReal*C_parent66(1,2) - 2.0_pReal*C_parent66(4,4))/3.0_pReal
- C_bar66(4,4) = (C_parent66(1,1) - C_parent66(1,2) + C_parent66(4,4))/3.0_pReal
- C_bar66(1,4) = (C_parent66(1,1) - C_parent66(1,2) - 2.0_pReal*C_parent66(4,4)) /(3.0_pReal*sqrt(2.0_pReal))
+ C_bar66(1,1) = (C_parent66(1,1) + C_parent66(1,2) + 2.0_pREAL*C_parent66(4,4))/2.0_pREAL
+ C_bar66(1,2) = (C_parent66(1,1) + 5.0_pREAL*C_parent66(1,2) - 2.0_pREAL*C_parent66(4,4))/6.0_pREAL
+ C_bar66(3,3) = (C_parent66(1,1) + 2.0_pREAL*C_parent66(1,2) + 4.0_pREAL*C_parent66(4,4))/3.0_pREAL
+ C_bar66(1,3) = (C_parent66(1,1) + 2.0_pREAL*C_parent66(1,2) - 2.0_pREAL*C_parent66(4,4))/3.0_pREAL
+ C_bar66(4,4) = (C_parent66(1,1) - C_parent66(1,2) + C_parent66(4,4))/3.0_pREAL
+ C_bar66(1,4) = (C_parent66(1,1) - C_parent66(1,2) - 2.0_pREAL*C_parent66(4,4)) /(3.0_pREAL*sqrt(2.0_pREAL))
- C_target_unrotated66 = 0.0_pReal
+ C_target_unrotated66 = 0.0_pREAL
C_target_unrotated66(1,1) = C_bar66(1,1) - C_bar66(1,4)**2/C_bar66(4,4)
C_target_unrotated66(1,2) = C_bar66(1,2) + C_bar66(1,4)**2/C_bar66(4,4)
C_target_unrotated66(1,3) = C_bar66(1,3)
C_target_unrotated66(3,3) = C_bar66(3,3)
- C_target_unrotated66(4,4) = C_bar66(4,4) - C_bar66(1,4)**2/(0.5_pReal*(C_bar66(1,1) - C_bar66(1,2)))
+ C_target_unrotated66(4,4) = C_bar66(4,4) - C_bar66(1,4)**2/(0.5_pREAL*(C_bar66(1,1) - C_bar66(1,2)))
C_target_unrotated66 = lattice_symmetrize_C66(C_target_unrotated66,'hP')
elseif (lattice_target == 'cI' .and. present(a_cF) .and. present(a_cI)) then
- if (a_cI <= 0.0_pReal .or. a_cF <= 0.0_pReal) &
+ if (a_cI <= 0.0_pREAL .or. a_cF <= 0.0_pREAL) &
call IO_error(134,ext_msg='lattice_C66_trans: '//trim(lattice_target))
C_target_unrotated66 = C_parent66
else
@@ -598,26 +598,26 @@ function lattice_C66_trans(Ntrans,C_parent66,lattice_target, &
function lattice_nonSchmidMatrix(Nslip,nonSchmidCoefficients,sense) result(nonSchmidMatrix)
integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
- real(pReal), dimension(:), intent(in) :: nonSchmidCoefficients !< non-Schmid coefficients for projections
+ real(pREAL), dimension(:), intent(in) :: nonSchmidCoefficients !< non-Schmid coefficients for projections
integer, intent(in) :: sense !< sense (-1,+1)
- real(pReal), dimension(1:3,1:3,sum(Nslip)) :: nonSchmidMatrix
+ real(pREAL), dimension(1:3,1:3,sum(Nslip)) :: nonSchmidMatrix
- real(pReal), dimension(1:3,1:3,sum(Nslip)) :: coordinateSystem !< coordinate system of slip system
- real(pReal), dimension(3) :: direction, normal, np
+ real(pREAL), dimension(1:3,1:3,sum(Nslip)) :: coordinateSystem !< coordinate system of slip system
+ real(pREAL), dimension(3) :: direction, normal, np
type(tRotation) :: R
integer :: i
if (abs(sense) /= 1) error stop 'Sense in lattice_nonSchmidMatrix'
- coordinateSystem = buildCoordinateSystem(Nslip,CI_NSLIPSYSTEM,CI_SYSTEMSLIP,'cI',0.0_pReal)
- coordinateSystem(1:3,1,1:sum(Nslip)) = coordinateSystem(1:3,1,1:sum(Nslip))*real(sense,pReal) ! convert unidirectional coordinate system
- nonSchmidMatrix = lattice_SchmidMatrix_slip(Nslip,'cI',0.0_pReal) ! Schmid contribution
+ coordinateSystem = buildCoordinateSystem(Nslip,CI_NSLIPSYSTEM,CI_SYSTEMSLIP,'cI',0.0_pREAL)
+ coordinateSystem(1:3,1,1:sum(Nslip)) = coordinateSystem(1:3,1,1:sum(Nslip))*real(sense,pREAL) ! convert unidirectional coordinate system
+ nonSchmidMatrix = lattice_SchmidMatrix_slip(Nslip,'cI',0.0_pREAL) ! Schmid contribution
do i = 1,sum(Nslip)
direction = coordinateSystem(1:3,1,i)
normal = coordinateSystem(1:3,2,i)
- call R%fromAxisAngle([direction,60.0_pReal],degrees=.true.,P=1)
+ call R%fromAxisAngle([direction,60.0_pREAL],degrees=.true.,P=1)
np = R%rotate(normal)
if (size(nonSchmidCoefficients)>0) nonSchmidMatrix(1:3,1:3,i) = nonSchmidMatrix(1:3,1:3,i) &
@@ -647,9 +647,9 @@ end function lattice_nonSchmidMatrix
function lattice_interaction_SlipBySlip(Nslip,interactionValues,lattice) result(interactionMatrix)
integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
- real(pReal), dimension(:), intent(in) :: interactionValues !< values for slip-slip interaction
+ real(pREAL), dimension(:), intent(in) :: interactionValues !< values for slip-slip interaction
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
- real(pReal), dimension(sum(Nslip),sum(Nslip)) :: interactionMatrix
+ real(pREAL), dimension(sum(Nslip),sum(Nslip)) :: interactionMatrix
integer, dimension(:), allocatable :: NslipMax
integer, dimension(:,:), allocatable :: interactionTypes
@@ -965,9 +965,9 @@ end function lattice_interaction_SlipBySlip
function lattice_interaction_TwinByTwin(Ntwin,interactionValues,lattice) result(interactionMatrix)
integer, dimension(:), intent(in) :: Ntwin !< number of active twin systems per family
- real(pReal), dimension(:), intent(in) :: interactionValues !< values for twin-twin interaction
+ real(pREAL), dimension(:), intent(in) :: interactionValues !< values for twin-twin interaction
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
- real(pReal), dimension(sum(Ntwin),sum(Ntwin)) :: interactionMatrix
+ real(pREAL), dimension(sum(Ntwin),sum(Ntwin)) :: interactionMatrix
integer, dimension(:), allocatable :: NtwinMax
integer, dimension(:,:), allocatable :: interactionTypes
@@ -1064,9 +1064,9 @@ end function lattice_interaction_TwinByTwin
function lattice_interaction_TransByTrans(Ntrans,interactionValues,lattice) result(interactionMatrix)
integer, dimension(:), intent(in) :: Ntrans !< number of active trans systems per family
- real(pReal), dimension(:), intent(in) :: interactionValues !< values for trans-trans interaction
+ real(pREAL), dimension(:), intent(in) :: interactionValues !< values for trans-trans interaction
character(len=*), intent(in) :: lattice ! 2.0_pReal) &
+ if (cOverA < 1.0_pREAL .or. cOverA > 2.0_pREAL) &
call IO_error(131,ext_msg='lattice_SchmidMatrix_trans: '//trim(lattice_target))
call buildTransformationSystem(devNull,SchmidMatrix,Ntrans,cOverA=cOverA)
else if (lattice_target == 'cI' .and. present(a_cF) .and. present(a_cI)) then
- if (a_cI <= 0.0_pReal .or. a_cF <= 0.0_pReal) &
+ if (a_cI <= 0.0_pREAL .or. a_cF <= 0.0_pREAL) &
call IO_error(134,ext_msg='lattice_SchmidMatrix_trans: '//trim(lattice_target))
call buildTransformationSystem(devNull,SchmidMatrix,Ntrans,a_cF=a_cF,a_cI=a_cI)
else
@@ -1522,11 +1522,11 @@ function lattice_SchmidMatrix_cleavage(Ncleavage,lattice,cOverA) result(SchmidMa
integer, dimension(:), intent(in) :: Ncleavage !< number of active cleavage systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
- real(pReal), intent(in) :: cOverA !< c/a ratio
- real(pReal), dimension(3,3,3,sum(Ncleavage)) :: SchmidMatrix
+ real(pREAL), intent(in) :: cOverA !< c/a ratio
+ real(pREAL), dimension(3,3,3,sum(Ncleavage)) :: SchmidMatrix
- real(pReal), dimension(3,3,sum(Ncleavage)) :: coordinateSystem
- real(pReal), dimension(:,:), allocatable :: cleavageSystems
+ real(pREAL), dimension(3,3,sum(Ncleavage)) :: coordinateSystem
+ real(pREAL), dimension(:,:), allocatable :: cleavageSystems
integer, dimension(:), allocatable :: NcleavageMax
integer :: i
@@ -1565,10 +1565,10 @@ function lattice_slip_direction(Nslip,lattice,cOverA) result(d)
integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
- real(pReal), intent(in) :: cOverA !< c/a ratio
- real(pReal), dimension(3,sum(Nslip)) :: d
+ real(pREAL), intent(in) :: cOverA !< c/a ratio
+ real(pREAL), dimension(3,sum(Nslip)) :: d
- real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem
+ real(pREAL), dimension(3,3,sum(Nslip)) :: coordinateSystem
coordinateSystem = coordinateSystem_slip(Nslip,lattice,cOverA)
d = coordinateSystem(1:3,1,1:sum(Nslip))
@@ -1583,10 +1583,10 @@ function lattice_slip_normal(Nslip,lattice,cOverA) result(n)
integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
- real(pReal), intent(in) :: cOverA !< c/a ratio
- real(pReal), dimension(3,sum(Nslip)) :: n
+ real(pREAL), intent(in) :: cOverA !< c/a ratio
+ real(pREAL), dimension(3,sum(Nslip)) :: n
- real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem
+ real(pREAL), dimension(3,3,sum(Nslip)) :: coordinateSystem
coordinateSystem = coordinateSystem_slip(Nslip,lattice,cOverA)
n = coordinateSystem(1:3,2,1:sum(Nslip))
@@ -1601,10 +1601,10 @@ function lattice_slip_transverse(Nslip,lattice,cOverA) result(t)
integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
- real(pReal), intent(in) :: cOverA !< c/a ratio
- real(pReal), dimension(3,sum(Nslip)) :: t
+ real(pREAL), intent(in) :: cOverA !< c/a ratio
+ real(pREAL), dimension(3,sum(Nslip)) :: t
- real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem
+ real(pREAL), dimension(3,3,sum(Nslip)) :: coordinateSystem
coordinateSystem = coordinateSystem_slip(Nslip,lattice,cOverA)
t = coordinateSystem(1:3,3,1:sum(Nslip))
@@ -1623,7 +1623,7 @@ function lattice_labels_slip(Nslip,lattice) result(labels)
character(len=:), dimension(:), allocatable :: labels
- real(pReal), dimension(:,:), allocatable :: slipSystems
+ real(pREAL), dimension(:,:), allocatable :: slipSystems
integer, dimension(:), allocatable :: NslipMax
select case(lattice)
@@ -1658,13 +1658,13 @@ end function lattice_labels_slip
!--------------------------------------------------------------------------------------------------
pure function lattice_symmetrize_33(T,lattice) result(T_sym)
- real(pReal), dimension(3,3) :: T_sym
+ real(pREAL), dimension(3,3) :: T_sym
- real(pReal), dimension(3,3), intent(in) :: T
+ real(pREAL), dimension(3,3), intent(in) :: T
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
- T_sym = 0.0_pReal
+ T_sym = 0.0_pREAL
select case(lattice)
case('cF','cI')
@@ -1686,15 +1686,15 @@ end function lattice_symmetrize_33
!--------------------------------------------------------------------------------------------------
pure function lattice_symmetrize_C66(C66,lattice) result(C66_sym)
- real(pReal), dimension(6,6) :: C66_sym
+ real(pREAL), dimension(6,6) :: C66_sym
- real(pReal), dimension(6,6), intent(in) :: C66
+ real(pREAL), dimension(6,6), intent(in) :: C66
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
integer :: i,j
- C66_sym = 0.0_pReal
+ C66_sym = 0.0_pREAL
select case(lattice)
case ('cF','cI')
@@ -1707,7 +1707,7 @@ pure function lattice_symmetrize_C66(C66,lattice) result(C66_sym)
C66_sym(1,2) = C66(1,2)
C66_sym(1,3) = C66(1,3); C66_sym(2,3) = C66(1,3)
C66_sym(4,4) = C66(4,4); C66_sym(5,5) = C66(4,4)
- C66_sym(6,6) = 0.5_pReal*(C66(1,1)-C66(1,2))
+ C66_sym(6,6) = 0.5_pREAL*(C66(1,1)-C66(1,2))
case ('tI')
C66_sym(1,1) = C66(1,1); C66_sym(2,2) = C66(1,1)
C66_sym(3,3) = C66(3,3)
@@ -1737,7 +1737,7 @@ function lattice_labels_twin(Ntwin,lattice) result(labels)
character(len=:), dimension(:), allocatable :: labels
- real(pReal), dimension(:,:), allocatable :: twinSystems
+ real(pREAL), dimension(:,:), allocatable :: twinSystems
integer, dimension(:), allocatable :: NtwinMax
select case(lattice)
@@ -1772,10 +1772,10 @@ function slipProjection_transverse(Nslip,lattice,cOverA) result(projection)
integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
- real(pReal), intent(in) :: cOverA !< c/a ratio
- real(pReal), dimension(sum(Nslip),sum(Nslip)) :: projection
+ real(pREAL), intent(in) :: cOverA !< c/a ratio
+ real(pREAL), dimension(sum(Nslip),sum(Nslip)) :: projection
- real(pReal), dimension(3,sum(Nslip)) :: n, t
+ real(pREAL), dimension(3,sum(Nslip)) :: n, t
integer :: i, j
n = lattice_slip_normal (Nslip,lattice,cOverA)
@@ -1796,10 +1796,10 @@ function slipProjection_direction(Nslip,lattice,cOverA) result(projection)
integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
- real(pReal), intent(in) :: cOverA !< c/a ratio
- real(pReal), dimension(sum(Nslip),sum(Nslip)) :: projection
+ real(pREAL), intent(in) :: cOverA !< c/a ratio
+ real(pREAL), dimension(sum(Nslip),sum(Nslip)) :: projection
- real(pReal), dimension(3,sum(Nslip)) :: n, d
+ real(pREAL), dimension(3,sum(Nslip)) :: n, d
integer :: i, j
n = lattice_slip_normal (Nslip,lattice,cOverA)
@@ -1820,10 +1820,10 @@ function coordinateSystem_slip(Nslip,lattice,cOverA) result(coordinateSystem)
integer, dimension(:), intent(in) :: Nslip !< number of active slip systems per family
character(len=*), intent(in) :: lattice !< Bravais lattice (Pearson symbol)
- real(pReal), intent(in) :: cOverA !< c/a ratio
- real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem
+ real(pREAL), intent(in) :: cOverA !< c/a ratio
+ real(pREAL), dimension(3,3,sum(Nslip)) :: coordinateSystem
- real(pReal), dimension(:,:), allocatable :: slipSystems
+ real(pREAL), dimension(:,:), allocatable :: slipSystems
integer, dimension(:), allocatable :: NslipMax
select case(lattice)
@@ -1864,9 +1864,9 @@ function buildInteraction(reacting_used,acting_used,reacting_max,acting_max,valu
acting_used, & !< # of acting systems per family as specified in material.config
reacting_max, & !< max # of reacting systems per family for given lattice
acting_max !< max # of acting systems per family for given lattice
- real(pReal), dimension(:), intent(in) :: values !< interaction values
+ real(pREAL), dimension(:), intent(in) :: values !< interaction values
integer, dimension(:,:), intent(in) :: matrix !< interaction types
- real(pReal), dimension(sum(reacting_used),sum(acting_used)) :: buildInteraction
+ real(pREAL), dimension(sum(reacting_used),sum(acting_used)) :: buildInteraction
integer :: &
acting_family_index, acting_family, acting_system, &
@@ -1906,16 +1906,16 @@ function buildCoordinateSystem(active,potential,system,lattice,cOverA)
integer, dimension(:), intent(in) :: &
active, & !< # of active systems per family
potential !< # of potential systems per family
- real(pReal), dimension(:,:), intent(in) :: &
+ real(pREAL), dimension(:,:), intent(in) :: &
system
character(len=*), intent(in) :: &
lattice !< Bravais lattice (Pearson symbol)
- real(pReal), intent(in) :: &
+ real(pREAL), intent(in) :: &
cOverA
- real(pReal), dimension(3,3,sum(active)) :: &
+ real(pREAL), dimension(3,3,sum(active)) :: &
buildCoordinateSystem
- real(pReal), dimension(3) :: &
+ real(pREAL), dimension(3) :: &
direction, normal
integer :: &
a, & !< index of active system
@@ -1923,9 +1923,9 @@ function buildCoordinateSystem(active,potential,system,lattice,cOverA)
f, & !< index of my family
s !< index of my system in current family
- if (lattice == 'tI' .and. cOverA > 2.0_pReal) &
+ if (lattice == 'tI' .and. cOverA > 2.0_pREAL) &
call IO_error(131,ext_msg='buildCoordinateSystem:'//trim(lattice))
- if (lattice == 'hP' .and. (cOverA < 1.0_pReal .or. cOverA > 2.0_pReal)) &
+ if (lattice == 'hP' .and. (cOverA < 1.0_pREAL .or. cOverA > 2.0_pREAL)) &
call IO_error(131,ext_msg='buildCoordinateSystem:'//trim(lattice))
a = 0
@@ -1941,11 +1941,11 @@ function buildCoordinateSystem(active,potential,system,lattice,cOverA)
normal = system(4:6,p)
case ('hP')
- direction = [ system(1,p)*1.5_pReal, &
- (system(1,p)+2.0_pReal*system(2,p))*sqrt(0.75_pReal), &
+ direction = [ system(1,p)*1.5_pREAL, &
+ (system(1,p)+2.0_pREAL*system(2,p))*sqrt(0.75_pREAL), &
system(4,p)*cOverA ] ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(p/a)])
normal = [ system(5,p), &
- (system(5,p)+2.0_pReal*system(6,p))/sqrt(3.0_pReal), &
+ (system(5,p)+2.0_pREAL*system(6,p))/sqrt(3.0_pREAL), &
system(8,p)/cOverA ] ! plane (hkil)->(h (h+2k)/sqrt(3) l/(p/a))
case default
@@ -1974,10 +1974,10 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_cF,a_cI)
integer, dimension(:), intent(in) :: &
Ntrans
- real(pReal), dimension(3,3,sum(Ntrans)), intent(out) :: &
+ real(pREAL), dimension(3,3,sum(Ntrans)), intent(out) :: &
Q, & !< Total rotation: Q = R*B
S !< Eigendeformation tensor for phase transformation
- real(pReal), optional, intent(in) :: &
+ real(pREAL), optional, intent(in) :: &
cOverA, & !< c/a for target hP lattice
a_cF, & !< lattice parameter a for cF target lattice
a_cI !< lattice parameter a for cI parent lattice
@@ -1985,14 +1985,14 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_cF,a_cI)
type(tRotation) :: &
R, & !< Pitsch rotation
B !< Rotation of cF to Bain coordinate system
- real(pReal), dimension(3,3) :: &
+ real(pREAL), dimension(3,3) :: &
U, & !< Bain deformation
ss, sd
- real(pReal), dimension(3) :: &
+ real(pREAL), dimension(3) :: &
x, y, z
integer :: &
i
- real(pReal), dimension(3+3,CF_NTRANS), parameter :: &
+ real(pREAL), dimension(3+3,CF_NTRANS), parameter :: &
CFTOHP_SYSTEMTRANS = reshape(real( [&
-2, 1, 1, 1, 1, 1, &
1,-2, 1, 1, 1, 1, &
@@ -2006,9 +2006,9 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_cF,a_cI)
2, 1,-1, -1, 1,-1, &
-1,-2,-1, -1, 1,-1, &
-1, 1, 2, -1, 1,-1 &
- ],pReal),shape(CFTOHP_SYSTEMTRANS))
+ ],pREAL),shape(CFTOHP_SYSTEMTRANS))
- real(pReal), dimension(4,cF_Ntrans), parameter :: &
+ real(pREAL), dimension(4,cF_Ntrans), parameter :: &
CFTOCI_SYSTEMTRANS = real(reshape([&
0.0, 1.0, 0.0, 10.26, & ! Pitsch OR (Ma & Hartmaier 2014, Table 3)
0.0,-1.0, 0.0, 10.26, &
@@ -2022,7 +2022,7 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_cF,a_cI)
-1.0, 0.0, 0.0, 10.26, &
0.0, 1.0, 0.0, 10.26, &
0.0,-1.0, 0.0, 10.26 &
- ],shape(CFTOCI_SYSTEMTRANS)),pReal)
+ ],shape(CFTOCI_SYSTEMTRANS)),pREAL)
integer, dimension(9,cF_Ntrans), parameter :: &
CFTOCI_BAINVARIANT = reshape( [&
@@ -2040,7 +2040,7 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_cF,a_cI)
0, 0, 1, 1, 0, 0, 0, 1, 0 &
],shape(CFTOCI_BAINVARIANT))
- real(pReal), dimension(4,cF_Ntrans), parameter :: &
+ real(pREAL), dimension(4,cF_Ntrans), parameter :: &
CFTOCI_BAINROT = real(reshape([&
1.0, 0.0, 0.0, 45.0, & ! Rotate cF austensite to bain variant
1.0, 0.0, 0.0, 45.0, &
@@ -2054,25 +2054,25 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_cF,a_cI)
0.0, 0.0, 1.0, 45.0, &
0.0, 0.0, 1.0, 45.0, &
0.0, 0.0, 1.0, 45.0 &
- ],shape(CFTOCI_BAINROT)),pReal)
+ ],shape(CFTOCI_BAINROT)),pREAL)
if (present(a_cI) .and. present(a_cF)) then
do i = 1,sum(Ntrans)
call R%fromAxisAngle(CFTOCI_SYSTEMTRANS(:,i),degrees=.true.,P=1)
call B%fromAxisAngle(CFTOCI_BAINROT(:,i), degrees=.true.,P=1)
- x = real(CFTOCI_BAINVARIANT(1:3,i),pReal)
- y = real(CFTOCI_BAINVARIANT(4:6,i),pReal)
- z = real(CFTOCI_BAINVARIANT(7:9,i),pReal)
+ x = real(CFTOCI_BAINVARIANT(1:3,i),pREAL)
+ y = real(CFTOCI_BAINVARIANT(4:6,i),pREAL)
+ z = real(CFTOCI_BAINVARIANT(7:9,i),pREAL)
- U = (a_cI/a_cF) * (math_outer(x,x) + (math_outer(y,y)+math_outer(z,z)) * sqrt(2.0_pReal))
+ U = (a_cI/a_cF) * (math_outer(x,x) + (math_outer(y,y)+math_outer(z,z)) * sqrt(2.0_pREAL))
Q(1:3,1:3,i) = matmul(R%asMatrix(),B%asMatrix())
S(1:3,1:3,i) = matmul(R%asMatrix(),U) - MATH_I3
end do
else if (present(cOverA)) then
ss = MATH_I3
sd = MATH_I3
- ss(1,3) = sqrt(2.0_pReal)/4.0_pReal
- sd(3,3) = cOverA/sqrt(8.0_pReal/3.0_pReal)
+ ss(1,3) = sqrt(2.0_pREAL)/4.0_pREAL
+ sd(3,3) = cOverA/sqrt(8.0_pREAL/3.0_pREAL)
do i = 1,sum(Ntrans)
x = CFTOHP_SYSTEMTRANS(1:3,i)/norm2(CFTOHP_SYSTEMTRANS(1:3,i))
@@ -2098,7 +2098,7 @@ function getlabels(active,potential,system) result(labels)
integer, dimension(:), intent(in) :: &
active, & !< # of active systems per family
potential !< # of potential systems per family
- real(pReal), dimension(:,:), intent(in) :: &
+ real(pREAL), dimension(:,:), intent(in) :: &
system
character(len=:), dimension(:), allocatable :: labels
@@ -2152,28 +2152,28 @@ end function getlabels
!--------------------------------------------------------------------------------------------------
pure function lattice_isotropic_nu(C,assumption,lattice) result(nu)
- real(pReal), dimension(6,6), intent(in) :: C !< Stiffness tensor (Voigt notation)
+ real(pREAL), dimension(6,6), intent(in) :: C !< Stiffness tensor (Voigt notation)
character(len=*), intent(in) :: assumption !< Assumption (isostrain = 'Voigt', isostress = 'Reuss')
character(len=*), optional, intent(in) :: lattice
- real(pReal) :: nu
+ real(pREAL) :: nu
- real(pReal) :: K, mu
+ real(pREAL) :: K, mu
logical :: error
- real(pReal), dimension(6,6) :: S
+ real(pREAL), dimension(6,6) :: S
if (IO_lc(assumption) == 'isostrain') then
- K = sum(C(1:3,1:3)) / 9.0_pReal
+ K = sum(C(1:3,1:3)) / 9.0_pREAL
elseif (IO_lc(assumption) == 'isostress') then
call math_invert(S,error,C)
if (error) error stop 'matrix inversion failed'
- K = 1.0_pReal / sum(S(1:3,1:3))
+ K = 1.0_pREAL / sum(S(1:3,1:3))
else
error stop 'invalid assumption'
end if
mu = lattice_isotropic_mu(C,assumption,lattice)
- nu = (1.5_pReal*K-mu)/(3.0_pReal*K+mu)
+ nu = (1.5_pREAL*K-mu)/(3.0_pREAL*K+mu)
end function lattice_isotropic_nu
@@ -2185,36 +2185,36 @@ end function lattice_isotropic_nu
!--------------------------------------------------------------------------------------------------
pure function lattice_isotropic_mu(C,assumption,lattice) result(mu)
- real(pReal), dimension(6,6), intent(in) :: C !< Stiffness tensor (Voigt notation)
+ real(pREAL), dimension(6,6), intent(in) :: C !< Stiffness tensor (Voigt notation)
character(len=*), intent(in) :: assumption !< Assumption (isostrain = 'Voigt', isostress = 'Reuss')
character(len=*), optional, intent(in) :: lattice
- real(pReal) :: mu
+ real(pREAL) :: mu
logical :: error
- real(pReal), dimension(6,6) :: S
+ real(pREAL), dimension(6,6) :: S
if (IO_lc(assumption) == 'isostrain') then
select case(misc_optional(lattice,''))
case('cF','cI')
- mu = ( C(1,1) - C(1,2) + C(4,4)*3.0_pReal) / 5.0_pReal
+ mu = ( C(1,1) - C(1,2) + C(4,4)*3.0_pREAL) / 5.0_pREAL
case default
mu = ( C(1,1)+C(2,2)+C(3,3) &
- C(1,2)-C(2,3)-C(1,3) &
- +(C(4,4)+C(5,5)+C(6,6)) * 3.0_pReal &
- ) / 15.0_pReal
+ +(C(4,4)+C(5,5)+C(6,6)) * 3.0_pREAL &
+ ) / 15.0_pREAL
end select
elseif (IO_lc(assumption) == 'isostress') then
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))
+ mu = 5.0_pREAL &
+ / (4.0_pREAL/(C(1,1)-C(1,2)) + 3.0_pREAL/C(4,4))
case default
call math_invert(S,error,C)
if (error) error stop 'matrix inversion failed'
- mu = 15.0_pReal &
- / (4.0_pReal*(S(1,1)+S(2,2)+S(3,3)-S(1,2)-S(2,3)-S(1,3)) + 3.0_pReal*(S(4,4)+S(5,5)+S(6,6)))
+ mu = 15.0_pREAL &
+ / (4.0_pREAL*(S(1,1)+S(2,2)+S(3,3)-S(1,2)-S(2,3)-S(1,3)) + 3.0_pREAL*(S(4,4)+S(5,5)+S(6,6)))
end select
else
error stop 'invalid assumption'
@@ -2228,20 +2228,20 @@ end function lattice_isotropic_mu
!--------------------------------------------------------------------------------------------------
subroutine selfTest
- real(pReal), dimension(:,:,:), allocatable :: CoSy
- real(pReal), dimension(:,:), allocatable :: system
+ real(pREAL), dimension(:,:,:), allocatable :: CoSy
+ real(pREAL), dimension(:,:), allocatable :: system
- real(pReal), dimension(6,6) :: C, C_cF, C_cI, C_hP, C_tI
- real(pReal), dimension(3,3) :: T, T_cF, T_cI, T_hP, T_tI
- real(pReal), dimension(2) :: r
- real(pReal) :: lambda
+ real(pREAL), dimension(6,6) :: C, C_cF, C_cI, C_hP, C_tI
+ real(pREAL), dimension(3,3) :: T, T_cF, T_cI, T_hP, T_tI
+ real(pREAL), dimension(2) :: r
+ real(pREAL) :: lambda
integer :: i
call random_number(r)
- system = reshape([1.0_pReal+r(1),0.0_pReal,0.0_pReal, 0.0_pReal,1.0_pReal+r(2),0.0_pReal],[6,1])
- CoSy = buildCoordinateSystem([1],[1],system,'cF',0.0_pReal)
+ system = reshape([1.0_pREAL+r(1),0.0_pREAL,0.0_pREAL, 0.0_pREAL,1.0_pREAL+r(2),0.0_pREAL],[6,1])
+ CoSy = buildCoordinateSystem([1],[1],system,'cF',0.0_pREAL)
if (any(dNeq(CoSy(1:3,1:3,1),math_I3))) error stop 'buildCoordinateSystem'
do i = 1, 10
@@ -2274,9 +2274,9 @@ subroutine selfTest
T_hP = lattice_symmetrize_33(T,'hP')
T_tI = lattice_symmetrize_33(T,'tI')
- if (any(dNeq0(T_cF) .and. math_I3<1.0_pReal)) error stop 'Symmetry33/c'
- if (any(dNeq0(T_hP) .and. math_I3<1.0_pReal)) error stop 'Symmetry33/hP'
- if (any(dNeq0(T_tI) .and. math_I3<1.0_pReal)) error stop 'Symmetry33/tI'
+ if (any(dNeq0(T_cF) .and. math_I3<1.0_pREAL)) error stop 'Symmetry33/c'
+ if (any(dNeq0(T_hP) .and. math_I3<1.0_pREAL)) error stop 'Symmetry33/hP'
+ if (any(dNeq0(T_tI) .and. math_I3<1.0_pREAL)) error stop 'Symmetry33/tI'
if (any(dNeq(T(1,1),[T_cI(1,1),T_cI(2,2),T_cI(3,3)]))) error stop 'Symmetry33_11-22-33/c'
if (any(dNeq(T(1,1),[T_hP(1,1),T_hP(2,2)]))) error stop 'Symmetry33_11-22/hP'
@@ -2285,52 +2285,52 @@ subroutine selfTest
end do
call random_number(C)
- C(1,1) = C(1,1) + C(1,2) + 0.1_pReal
+ C(1,1) = C(1,1) + C(1,2) + 0.1_pREAL
C(1,3) = C(1,2)
C(3,3) = C(1,1)
- C(4,4) = 0.5_pReal * (C(1,1) - C(1,2))
+ C(4,4) = 0.5_pREAL * (C(1,1) - C(1,2))
C(6,6) = C(4,4)
C_cI = lattice_symmetrize_C66(C,'cI')
- if (dNeq(C_cI(4,4),lattice_isotropic_mu(C_cI,'isostrain','cI'),1.0e-12_pReal)) error stop 'isotropic_mu/isostrain/cI'
- if (dNeq(C_cI(4,4),lattice_isotropic_mu(C_cI,'isostress','cI'),1.0e-12_pReal)) error stop 'isotropic_mu/isostress/cI'
+ if (dNeq(C_cI(4,4),lattice_isotropic_mu(C_cI,'isostrain','cI'),1.0e-12_pREAL)) error stop 'isotropic_mu/isostrain/cI'
+ if (dNeq(C_cI(4,4),lattice_isotropic_mu(C_cI,'isostress','cI'),1.0e-12_pREAL)) error stop 'isotropic_mu/isostress/cI'
lambda = C_cI(1,2)
- if (dNeq(lambda*0.5_pReal/(lambda+lattice_isotropic_mu(C_cI,'isostrain','cI')), &
- lattice_isotropic_nu(C_cI,'isostrain','cI'),1.0e-12_pReal)) error stop 'isotropic_nu/isostrain/cI'
- if (dNeq(lambda*0.5_pReal/(lambda+lattice_isotropic_mu(C_cI,'isostress','cI')), &
- lattice_isotropic_nu(C_cI,'isostress','cI'),1.0e-12_pReal)) error stop 'isotropic_nu/isostress/cI'
+ if (dNeq(lambda*0.5_pREAL/(lambda+lattice_isotropic_mu(C_cI,'isostrain','cI')), &
+ lattice_isotropic_nu(C_cI,'isostrain','cI'),1.0e-12_pREAL)) error stop 'isotropic_nu/isostrain/cI'
+ if (dNeq(lambda*0.5_pREAL/(lambda+lattice_isotropic_mu(C_cI,'isostress','cI')), &
+ lattice_isotropic_nu(C_cI,'isostress','cI'),1.0e-12_pREAL)) error stop 'isotropic_nu/isostress/cI'
C_hP = lattice_symmetrize_C66(C,'hP')
- if (dNeq(C(4,4),lattice_isotropic_mu(C_hP,'isostrain','hP'),1.0e-12_pReal)) error stop 'isotropic_mu/isostrain/hP'
- if (dNeq(C(4,4),lattice_isotropic_mu(C_hP,'isostress','hP'),1.0e-12_pReal)) error stop 'isotropic_mu/isostress/hP'
+ if (dNeq(C(4,4),lattice_isotropic_mu(C_hP,'isostrain','hP'),1.0e-12_pREAL)) error stop 'isotropic_mu/isostrain/hP'
+ if (dNeq(C(4,4),lattice_isotropic_mu(C_hP,'isostress','hP'),1.0e-12_pREAL)) error stop 'isotropic_mu/isostress/hP'
lambda = C_hP(1,2)
- if (dNeq(lambda*0.5_pReal/(lambda+lattice_isotropic_mu(C_hP,'isostrain','hP')), &
- lattice_isotropic_nu(C_hP,'isostrain','hP'),1.0e-12_pReal)) error stop 'isotropic_nu/isostrain/hP'
- if (dNeq(lambda*0.5_pReal/(lambda+lattice_isotropic_mu(C_hP,'isostress','hP')), &
- lattice_isotropic_nu(C_hP,'isostress','hP'),1.0e-12_pReal)) error stop 'isotropic_nu/isostress/hP'
+ if (dNeq(lambda*0.5_pREAL/(lambda+lattice_isotropic_mu(C_hP,'isostrain','hP')), &
+ lattice_isotropic_nu(C_hP,'isostrain','hP'),1.0e-12_pREAL)) error stop 'isotropic_nu/isostrain/hP'
+ if (dNeq(lambda*0.5_pREAL/(lambda+lattice_isotropic_mu(C_hP,'isostress','hP')), &
+ lattice_isotropic_nu(C_hP,'isostress','hP'),1.0e-12_pREAL)) error stop 'isotropic_nu/isostress/hP'
C_tI = lattice_symmetrize_C66(C,'tI')
- if (dNeq(C(6,6),lattice_isotropic_mu(C_tI,'isostrain','tI'),1.0e-12_pReal)) error stop 'isotropic_mu/isostrain/tI'
- if (dNeq(C(6,6),lattice_isotropic_mu(C_tI,'isostress','tI'),1.0e-12_pReal)) error stop 'isotropic_mu/isostress/tI'
+ if (dNeq(C(6,6),lattice_isotropic_mu(C_tI,'isostrain','tI'),1.0e-12_pREAL)) error stop 'isotropic_mu/isostrain/tI'
+ if (dNeq(C(6,6),lattice_isotropic_mu(C_tI,'isostress','tI'),1.0e-12_pREAL)) error stop 'isotropic_mu/isostress/tI'
lambda = C_tI(1,2)
- if (dNeq(lambda*0.5_pReal/(lambda+lattice_isotropic_mu(C_tI,'isostrain','tI')), &
- lattice_isotropic_nu(C_tI,'isostrain','tI'),1.0e-12_pReal)) error stop 'isotropic_nu/isostrain/tI'
- if (dNeq(lambda*0.5_pReal/(lambda+lattice_isotropic_mu(C_tI,'isostress','tI')), &
- lattice_isotropic_nu(C_tI,'isostress','tI'),1.0e-12_pReal)) error stop 'isotropic_nu/isostress/tI'
+ if (dNeq(lambda*0.5_pREAL/(lambda+lattice_isotropic_mu(C_tI,'isostrain','tI')), &
+ lattice_isotropic_nu(C_tI,'isostrain','tI'),1.0e-12_pREAL)) error stop 'isotropic_nu/isostrain/tI'
+ if (dNeq(lambda*0.5_pREAL/(lambda+lattice_isotropic_mu(C_tI,'isostress','tI')), &
+ lattice_isotropic_nu(C_tI,'isostress','tI'),1.0e-12_pREAL)) error stop 'isotropic_nu/isostress/tI'
call random_number(C)
C = lattice_symmetrize_C66(C+math_eye(6),'cI')
- if (dNeq(lattice_isotropic_mu(C,'isostrain','cI'), lattice_isotropic_mu(C,'isostrain','hP'), 1.0e-12_pReal)) &
+ if (dNeq(lattice_isotropic_mu(C,'isostrain','cI'), lattice_isotropic_mu(C,'isostrain','hP'), 1.0e-12_pREAL)) &
error stop 'isotropic_mu/isostrain/cI-hP'
- if (dNeq(lattice_isotropic_nu(C,'isostrain','cF'), lattice_isotropic_nu(C,'isostrain','cI'), 1.0e-12_pReal)) &
+ if (dNeq(lattice_isotropic_nu(C,'isostrain','cF'), lattice_isotropic_nu(C,'isostrain','cI'), 1.0e-12_pREAL)) &
error stop 'isotropic_nu/isostrain/cF-tI'
- if (dNeq(lattice_isotropic_mu(C,'isostress','cI'), lattice_isotropic_mu(C,'isostress'), 1.0e-12_pReal)) &
+ if (dNeq(lattice_isotropic_mu(C,'isostress','cI'), lattice_isotropic_mu(C,'isostress'), 1.0e-12_pREAL)) &
error stop 'isotropic_mu/isostress/cI-hP'
- if (dNeq(lattice_isotropic_nu(C,'isostress','cF'), lattice_isotropic_nu(C,'isostress'), 1.0e-12_pReal)) &
+ if (dNeq(lattice_isotropic_nu(C,'isostress','cF'), lattice_isotropic_nu(C,'isostress'), 1.0e-12_pREAL)) &
error stop 'isotropic_nu/isostress/cF-tI'
end subroutine selfTest
diff --git a/src/material.f90 b/src/material.f90
index 2169c876a..82345fb1e 100644
--- a/src/material.f90
+++ b/src/material.f90
@@ -22,7 +22,7 @@ module material
end type tRotationContainer
type, public :: tTensorContainer
- real(pReal), dimension(:,:,:), allocatable :: data
+ real(pREAL), dimension(:,:,:), allocatable :: data
end type tTensorContainer
@@ -45,7 +45,7 @@ module material
material_ID_phase, & !< Number of the phase
material_entry_phase !< Position in array of used phase
- real(pReal), dimension(:,:), allocatable, public, protected :: &
+ real(pREAL), dimension(:,:), allocatable, public, protected :: &
material_v ! fraction
public :: &
@@ -97,9 +97,9 @@ subroutine parse()
counterHomogenization, &
ho_of
integer, dimension(:,:), allocatable :: ph_of
- real(pReal), dimension(:,:), allocatable :: v_of
+ real(pREAL), dimension(:,:), allocatable :: v_of
- real(pReal) :: v
+ real(pREAL) :: v
integer :: &
el, ip, &
ho, ph, &
@@ -125,20 +125,20 @@ subroutine parse()
end do
homogenization_maxNconstituents = maxval(homogenization_Nconstituents)
- allocate(material_v(homogenization_maxNconstituents,discretization_Ncells),source=0.0_pReal)
+ allocate(material_v(homogenization_maxNconstituents,discretization_Ncells),source=0.0_pREAL)
allocate(material_O_0(materials%length))
allocate(material_V_e_0(materials%length))
allocate(ho_of(materials%length))
allocate(ph_of(materials%length,homogenization_maxNconstituents),source=-1)
- allocate( v_of(materials%length,homogenization_maxNconstituents),source=0.0_pReal)
+ allocate( v_of(materials%length,homogenization_maxNconstituents),source=0.0_pREAL)
! Parse YAML structure. Manual loop over linked list to have O(n) instead of O(n^2) complexity
item => materials%first
do ma = 1, materials%length
material => item%node%asDict()
- ho_of(ma) = homogenizations%index(material%get_asString('homogenization'))
+ ho_of(ma) = homogenizations%index(material%get_asStr('homogenization'))
constituents => material%get_list('constituents')
homogenization => homogenizations%get_dict(ho_of(ma))
@@ -149,16 +149,16 @@ subroutine parse()
do co = 1, constituents%length
constituent => constituents%get_dict(co)
- v_of(ma,co) = constituent%get_asFloat('v')
- ph_of(ma,co) = phases%index(constituent%get_asString('phase'))
+ v_of(ma,co) = constituent%get_asReal('v')
+ ph_of(ma,co) = phases%index(constituent%get_asStr('phase'))
- call material_O_0(ma)%data(co)%fromQuaternion(constituent%get_as1dFloat('O',requiredSize=4))
- material_V_e_0(ma)%data(1:3,1:3,co) = constituent%get_as2dFloat('V_e',defaultVal=math_I3,requiredShape=[3,3])
+ call material_O_0(ma)%data(co)%fromQuaternion(constituent%get_as1dReal('O',requiredSize=4))
+ material_V_e_0(ma)%data(1:3,1:3,co) = constituent%get_as2dReal('V_e',defaultVal=math_I3,requiredShape=[3,3])
if (any(dNeq(material_V_e_0(ma)%data(1:3,1:3,co),transpose(material_V_e_0(ma)%data(1:3,1:3,co))))) &
call IO_error(147)
end do
- if (dNeq(sum(v_of(ma,:)),1.0_pReal,1.e-9_pReal)) call IO_error(153,ext_msg='constituent')
+ if (dNeq(sum(v_of(ma,:)),1.0_pREAL,1.e-9_pREAL)) call IO_error(153,ext_msg='constituent')
item => item%next
end do
@@ -212,8 +212,8 @@ end subroutine parse
function getKeys(dict)
type(tDict), intent(in) :: dict
- character(len=:), dimension(:), allocatable :: getKeys
- character(len=pStringLen), dimension(:), allocatable :: temp
+ character(len=:), dimension(:), allocatable :: getKeys
+ character(len=pSTRLEN), dimension(:), allocatable :: temp
integer :: i,l
diff --git a/src/materialpoint.f90 b/src/materialpoint.f90
index dda2e5870..f624a4db3 100644
--- a/src/materialpoint.f90
+++ b/src/materialpoint.f90
@@ -141,7 +141,7 @@ end subroutine materialpoint_forward
subroutine materialpoint_result(inc,time)
integer, intent(in) :: inc
- real(pReal), intent(in) :: time
+ real(pREAL), intent(in) :: time
call result_openJobFile()
call result_addIncrement(inc,time)
diff --git a/src/math.f90 b/src/math.f90
index 3c1f5b608..4a1ffb707 100644
--- a/src/math.f90
+++ b/src/math.f90
@@ -31,24 +31,24 @@ module math
config
#endif
- real(pReal), parameter :: &
- PI = acos(-1.0_pReal), & !< ratio of a circle's circumference to its diameter
- TAU = 2.0_pReal*PI, & !< ratio of a circle's circumference to its radius
- INDEG = 360.0_pReal/TAU, & !< conversion from radian to degree
- INRAD = TAU/360.0_pReal !< conversion from degree to radian
+ real(pREAL), parameter :: &
+ PI = acos(-1.0_pREAL), & !< ratio of a circle's circumference to its diameter
+ TAU = 2.0_pREAL*PI, & !< ratio of a circle's circumference to its radius
+ INDEG = 360.0_pREAL/TAU, & !< conversion from radian to degree
+ INRAD = TAU/360.0_pREAL !< conversion from degree to radian
- real(pReal), dimension(3,3), parameter :: &
+ real(pREAL), dimension(3,3), parameter :: &
math_I3 = reshape([&
- 1.0_pReal,0.0_pReal,0.0_pReal, &
- 0.0_pReal,1.0_pReal,0.0_pReal, &
- 0.0_pReal,0.0_pReal,1.0_pReal &
+ 1.0_pREAL,0.0_pREAL,0.0_pREAL, &
+ 0.0_pREAL,1.0_pREAL,0.0_pREAL, &
+ 0.0_pREAL,0.0_pREAL,1.0_pREAL &
],shape(math_I3)) !< 3x3 Identity
- real(pReal), dimension(*), parameter, private :: &
- NRMMANDEL = [1.0_pReal, 1.0_pReal,1.0_pReal, sqrt(2.0_pReal), sqrt(2.0_pReal), sqrt(2.0_pReal)] !< forward weighting for Mandel notation
+ real(pREAL), dimension(*), parameter, private :: &
+ NRMMANDEL = [1.0_pREAL, 1.0_pREAL,1.0_pREAL, sqrt(2.0_pREAL), sqrt(2.0_pREAL), sqrt(2.0_pREAL)] !< forward weighting for Mandel notation
- real(pReal), dimension(*), parameter, private :: &
- INVNRMMANDEL = 1.0_pReal/NRMMANDEL !< backward weighting for Mandel notation
+ real(pREAL), dimension(*), parameter, private :: &
+ INVNRMMANDEL = 1.0_pREAL/NRMMANDEL !< backward weighting for Mandel notation
integer, dimension (2,6), parameter, private :: &
MAPNYE = reshape([&
@@ -94,7 +94,7 @@ contains
!--------------------------------------------------------------------------------------------------
subroutine math_init()
- real(pReal), dimension(4) :: randTest
+ real(pREAL), dimension(4) :: randTest
integer :: randSize
integer, dimension(:), allocatable :: seed
type(tDict), pointer :: &
@@ -201,9 +201,9 @@ end subroutine math_sort
!--------------------------------------------------------------------------------------------------
pure function math_expand(what,how)
- real(pReal), dimension(:), intent(in) :: what
+ real(pREAL), dimension(:), intent(in) :: what
integer, dimension(:), intent(in) :: how
- real(pReal), dimension(sum(how)) :: math_expand
+ real(pREAL), dimension(sum(how)) :: math_expand
integer :: i
@@ -239,14 +239,14 @@ end function math_range
pure function math_eye(d)
integer, intent(in) :: d !< tensor dimension
- real(pReal), dimension(d,d) :: math_eye
+ real(pREAL), dimension(d,d) :: math_eye
integer :: i
- math_eye = 0.0_pReal
+ math_eye = 0.0_pREAL
do i=1,d
- math_eye(i,i) = 1.0_pReal
+ math_eye(i,i) = 1.0_pREAL
end do
end function math_eye
@@ -258,18 +258,18 @@ end function math_eye
!--------------------------------------------------------------------------------------------------
pure function math_identity4th()
- real(pReal), dimension(3,3,3,3) :: math_identity4th
+ real(pREAL), dimension(3,3,3,3) :: math_identity4th
integer :: i,j,k,l
#ifndef __INTEL_COMPILER
do concurrent(i=1:3, j=1:3, k=1:3, l=1:3)
- math_identity4th(i,j,k,l) = 0.5_pReal*(math_I3(i,k)*math_I3(j,l)+math_I3(i,l)*math_I3(j,k))
+ math_identity4th(i,j,k,l) = 0.5_pREAL*(math_I3(i,k)*math_I3(j,l)+math_I3(i,l)*math_I3(j,k))
end do
#else
forall(i=1:3, j=1:3, k=1:3, l=1:3) &
- math_identity4th(i,j,k,l) = 0.5_pReal*(math_I3(i,k)*math_I3(j,l)+math_I3(i,l)*math_I3(j,k))
+ math_identity4th(i,j,k,l) = 0.5_pREAL*(math_I3(i,k)*math_I3(j,l)+math_I3(i,l)*math_I3(j,k))
#endif
end function math_identity4th
@@ -281,7 +281,7 @@ end function math_identity4th
! e_ijk = -1 if odd permutation of ijk
! e_ijk = 0 otherwise
!--------------------------------------------------------------------------------------------------
-real(pReal) pure function math_LeviCivita(i,j,k)
+real(pREAL) pure function math_LeviCivita(i,j,k)
integer, intent(in) :: i,j,k
@@ -289,11 +289,11 @@ real(pReal) pure function math_LeviCivita(i,j,k)
if (any([(all(cshift([i,j,k],o) == [1,2,3]),o=0,2)])) then
- math_LeviCivita = +1.0_pReal
+ math_LeviCivita = +1.0_pREAL
elseif (any([(all(cshift([i,j,k],o) == [3,2,1]),o=0,2)])) then
- math_LeviCivita = -1.0_pReal
+ math_LeviCivita = -1.0_pREAL
else
- math_LeviCivita = 0.0_pReal
+ math_LeviCivita = 0.0_pREAL
end if
end function math_LeviCivita
@@ -304,12 +304,12 @@ end function math_LeviCivita
! d_ij = 1 if i = j
! d_ij = 0 otherwise
!--------------------------------------------------------------------------------------------------
-real(pReal) pure function math_delta(i,j)
+real(pREAL) pure function math_delta(i,j)
integer, intent (in) :: i,j
- math_delta = merge(0.0_pReal, 1.0_pReal, i /= j)
+ math_delta = merge(0.0_pREAL, 1.0_pREAL, i /= j)
end function math_delta
@@ -319,8 +319,8 @@ end function math_delta
!--------------------------------------------------------------------------------------------------
pure function math_cross(A,B)
- real(pReal), dimension(3), intent(in) :: A,B
- real(pReal), dimension(3) :: math_cross
+ real(pREAL), dimension(3), intent(in) :: A,B
+ real(pREAL), dimension(3) :: math_cross
math_cross = [ A(2)*B(3) -A(3)*B(2), &
@@ -335,8 +335,8 @@ end function math_cross
!--------------------------------------------------------------------------------------------------
pure function math_outer(A,B)
- real(pReal), dimension(:), intent(in) :: A,B
- real(pReal), dimension(size(A,1),size(B,1)) :: math_outer
+ real(pREAL), dimension(:), intent(in) :: A,B
+ real(pREAL), dimension(size(A,1),size(B,1)) :: math_outer
integer :: i,j
@@ -355,10 +355,10 @@ end function math_outer
!--------------------------------------------------------------------------------------------------
!> @brief inner product of arbitrary sized vectors (A · B / i,i)
!--------------------------------------------------------------------------------------------------
-real(pReal) pure function math_inner(A,B)
+real(pREAL) pure function math_inner(A,B)
- real(pReal), dimension(:), intent(in) :: A
- real(pReal), dimension(size(A,1)), intent(in) :: B
+ real(pREAL), dimension(:), intent(in) :: A
+ real(pREAL), dimension(size(A,1)), intent(in) :: B
math_inner = sum(A*B)
@@ -369,9 +369,9 @@ end function math_inner
!--------------------------------------------------------------------------------------------------
!> @brief double contraction of 3x3 matrices (A : B / ij,ij)
!--------------------------------------------------------------------------------------------------
-real(pReal) pure function math_tensordot(A,B)
+real(pREAL) pure function math_tensordot(A,B)
- real(pReal), dimension(3,3), intent(in) :: A,B
+ real(pREAL), dimension(3,3), intent(in) :: A,B
math_tensordot = sum(A*B)
@@ -384,9 +384,9 @@ end function math_tensordot
!--------------------------------------------------------------------------------------------------
pure function math_mul3333xx33(A,B)
- real(pReal), dimension(3,3,3,3), intent(in) :: A
- real(pReal), dimension(3,3), intent(in) :: B
- real(pReal), dimension(3,3) :: math_mul3333xx33
+ real(pREAL), dimension(3,3,3,3), intent(in) :: A
+ real(pREAL), dimension(3,3), intent(in) :: B
+ real(pREAL), dimension(3,3) :: math_mul3333xx33
integer :: i,j
@@ -407,9 +407,9 @@ end function math_mul3333xx33
!--------------------------------------------------------------------------------------------------
pure function math_mul3333xx3333(A,B)
- real(pReal), dimension(3,3,3,3), intent(in) :: A
- real(pReal), dimension(3,3,3,3), intent(in) :: B
- real(pReal), dimension(3,3,3,3) :: math_mul3333xx3333
+ real(pREAL), dimension(3,3,3,3), intent(in) :: A
+ real(pREAL), dimension(3,3,3,3), intent(in) :: B
+ real(pREAL), dimension(3,3,3,3) :: math_mul3333xx3333
integer :: i,j,k,l
@@ -430,20 +430,20 @@ end function math_mul3333xx3333
!--------------------------------------------------------------------------------------------------
pure function math_exp33(A,n)
- real(pReal), dimension(3,3), intent(in) :: A
+ real(pREAL), dimension(3,3), intent(in) :: A
integer, intent(in), optional :: n
- real(pReal), dimension(3,3) :: B, math_exp33
+ real(pREAL), dimension(3,3) :: B, math_exp33
- real(pReal) :: invFac
+ real(pREAL) :: invFac
integer :: i
- invFac = 1.0_pReal ! 0!
+ invFac = 1.0_pREAL ! 0!
B = math_I3
math_exp33 = math_I3 ! A^0 = I
do i = 1, misc_optional(n,5)
- invFac = invFac/real(i,pReal) ! invfac = 1/(i!)
+ invFac = invFac/real(i,pREAL) ! invfac = 1/(i!)
B = matmul(B,A)
math_exp33 = math_exp33 + invFac*B ! exp = SUM (A^i)/(i!)
end do
@@ -458,15 +458,15 @@ end function math_exp33
!--------------------------------------------------------------------------------------------------
pure function math_inv33(A)
- real(pReal), dimension(3,3), intent(in) :: A
- real(pReal), dimension(3,3) :: math_inv33
+ real(pREAL), dimension(3,3), intent(in) :: A
+ real(pREAL), dimension(3,3) :: math_inv33
- real(pReal) :: DetA
+ real(pREAL) :: DetA
logical :: error
call math_invert33(math_inv33,DetA,error,A)
- if (error) math_inv33 = 0.0_pReal
+ if (error) math_inv33 = 0.0_pREAL
end function math_inv33
@@ -478,12 +478,12 @@ end function math_inv33
!--------------------------------------------------------------------------------------------------
pure subroutine math_invert33(InvA,DetA,error, A)
- real(pReal), dimension(3,3), intent(out) :: InvA
- real(pReal), intent(out), optional :: DetA
+ real(pREAL), dimension(3,3), intent(out) :: InvA
+ real(pREAL), intent(out), optional :: DetA
logical, intent(out) :: error
- real(pReal), dimension(3,3), intent(in) :: A
+ real(pREAL), dimension(3,3), intent(in) :: A
- real(pReal) :: Det
+ real(pREAL) :: Det
InvA(1,1) = A(2,2) * A(3,3) - A(2,3) * A(3,2)
@@ -493,8 +493,8 @@ pure subroutine math_invert33(InvA,DetA,error, A)
Det = A(1,1) * InvA(1,1) + A(1,2) * InvA(2,1) + A(1,3) * InvA(3,1)
if (dEq0(Det)) then
- InvA = 0.0_pReal
- if (present(DetA)) DetA = 0.0_pReal
+ InvA = 0.0_pREAL
+ if (present(DetA)) DetA = 0.0_pREAL
error = .true.
else
InvA(1,2) = -A(1,2) * A(3,3) + A(1,3) * A(3,2)
@@ -518,13 +518,13 @@ end subroutine math_invert33
!--------------------------------------------------------------------------------------------------
pure function math_invSym3333(A)
- real(pReal),dimension(3,3,3,3) :: math_invSym3333
+ real(pREAL),dimension(3,3,3,3) :: math_invSym3333
- real(pReal),dimension(3,3,3,3),intent(in) :: A
+ real(pREAL),dimension(3,3,3,3),intent(in) :: A
integer, dimension(6) :: ipiv6
- real(pReal), dimension(6,6) :: temp66
- real(pReal), dimension(6*6) :: work
+ real(pREAL), dimension(6,6) :: temp66
+ real(pREAL), dimension(6*6) :: work
integer :: ierr_i, ierr_f
@@ -545,12 +545,12 @@ end function math_invSym3333
!--------------------------------------------------------------------------------------------------
pure subroutine math_invert(InvA, error, A)
- real(pReal), dimension(:,:), intent(in) :: A
- real(pReal), dimension(size(A,1),size(A,1)), intent(out) :: invA
+ real(pREAL), dimension(:,:), intent(in) :: A
+ real(pREAL), dimension(size(A,1),size(A,1)), intent(out) :: invA
logical, intent(out) :: error
integer, dimension(size(A,1)) :: ipiv
- real(pReal), dimension(size(A,1)**2) :: work
+ real(pREAL), dimension(size(A,1)**2) :: work
integer :: ierr
@@ -568,11 +568,11 @@ end subroutine math_invert
!--------------------------------------------------------------------------------------------------
pure function math_symmetric33(m)
- real(pReal), dimension(3,3) :: math_symmetric33
- real(pReal), dimension(3,3), intent(in) :: m
+ real(pREAL), dimension(3,3) :: math_symmetric33
+ real(pREAL), dimension(3,3), intent(in) :: m
- math_symmetric33 = 0.5_pReal * (m + transpose(m))
+ math_symmetric33 = 0.5_pREAL * (m + transpose(m))
end function math_symmetric33
@@ -582,8 +582,8 @@ end function math_symmetric33
!--------------------------------------------------------------------------------------------------
pure function math_skew33(m)
- real(pReal), dimension(3,3) :: math_skew33
- real(pReal), dimension(3,3), intent(in) :: m
+ real(pREAL), dimension(3,3) :: math_skew33
+ real(pREAL), dimension(3,3), intent(in) :: m
math_skew33 = m - math_symmetric33(m)
@@ -596,11 +596,11 @@ end function math_skew33
!--------------------------------------------------------------------------------------------------
pure function math_spherical33(m)
- real(pReal), dimension(3,3) :: math_spherical33
- real(pReal), dimension(3,3), intent(in) :: m
+ real(pREAL), dimension(3,3) :: math_spherical33
+ real(pREAL), dimension(3,3), intent(in) :: m
- math_spherical33 = math_I3 * math_trace33(m)/3.0_pReal
+ math_spherical33 = math_I3 * math_trace33(m)/3.0_pREAL
end function math_spherical33
@@ -610,8 +610,8 @@ end function math_spherical33
!--------------------------------------------------------------------------------------------------
pure function math_deviatoric33(m)
- real(pReal), dimension(3,3) :: math_deviatoric33
- real(pReal), dimension(3,3), intent(in) :: m
+ real(pREAL), dimension(3,3) :: math_deviatoric33
+ real(pREAL), dimension(3,3), intent(in) :: m
math_deviatoric33 = m - math_spherical33(m)
@@ -622,9 +622,9 @@ end function math_deviatoric33
!--------------------------------------------------------------------------------------------------
!> @brief Calculate trace of a 3x3 matrix.
!--------------------------------------------------------------------------------------------------
-real(pReal) pure function math_trace33(m)
+real(pREAL) pure function math_trace33(m)
- real(pReal), dimension(3,3), intent(in) :: m
+ real(pREAL), dimension(3,3), intent(in) :: m
math_trace33 = m(1,1) + m(2,2) + m(3,3)
@@ -635,9 +635,9 @@ end function math_trace33
!--------------------------------------------------------------------------------------------------
!> @brief Calculate determinant of a 3x3 matrix.
!--------------------------------------------------------------------------------------------------
-real(pReal) pure function math_det33(m)
+real(pREAL) pure function math_det33(m)
- real(pReal), dimension(3,3), intent(in) :: m
+ real(pREAL), dimension(3,3), intent(in) :: m
math_det33 = m(1,1)* (m(2,2)*m(3,3)-m(2,3)*m(3,2)) &
@@ -650,13 +650,13 @@ end function math_det33
!--------------------------------------------------------------------------------------------------
!> @brief Calculate determinant of a symmetric 3x3 matrix.
!--------------------------------------------------------------------------------------------------
-real(pReal) pure function math_detSym33(m)
+real(pREAL) pure function math_detSym33(m)
- real(pReal), dimension(3,3), intent(in) :: m
+ real(pREAL), dimension(3,3), intent(in) :: m
math_detSym33 = -(m(1,1)*m(2,3)**2 + m(2,2)*m(1,3)**2 + m(3,3)*m(1,2)**2) &
- + m(1,1)*m(2,2)*m(3,3) + 2.0_pReal * m(1,2)*m(1,3)*m(2,3)
+ + m(1,1)*m(2,2)*m(3,3) + 2.0_pREAL * m(1,2)*m(1,3)*m(2,3)
end function math_detSym33
@@ -666,8 +666,8 @@ end function math_detSym33
!--------------------------------------------------------------------------------------------------
pure function math_33to9(m33)
- real(pReal), dimension(9) :: math_33to9
- real(pReal), dimension(3,3), intent(in) :: m33
+ real(pREAL), dimension(9) :: math_33to9
+ real(pREAL), dimension(3,3), intent(in) :: m33
integer :: i
@@ -682,8 +682,8 @@ end function math_33to9
!--------------------------------------------------------------------------------------------------
pure function math_9to33(v9)
- real(pReal), dimension(3,3) :: math_9to33
- real(pReal), dimension(9), intent(in) :: v9
+ real(pREAL), dimension(3,3) :: math_9to33
+ real(pREAL), dimension(9), intent(in) :: v9
integer :: i
@@ -703,14 +703,14 @@ end function math_9to33
!--------------------------------------------------------------------------------------------------
pure function math_sym33to6(m33,weighted)
- real(pReal), dimension(6) :: math_sym33to6
- real(pReal), dimension(3,3), intent(in) :: m33 !< symmetric 3x3 matrix (no internal check)
+ real(pREAL), dimension(6) :: math_sym33to6
+ real(pREAL), dimension(3,3), intent(in) :: m33 !< symmetric 3x3 matrix (no internal check)
logical, optional, intent(in) :: weighted !< weight according to Mandel (.true. by default)
- real(pReal), dimension(6) :: w
+ real(pREAL), dimension(6) :: w
integer :: i
- w = merge(NRMMANDEL,1.0_pReal,misc_optional(weighted,.true.))
+ w = merge(NRMMANDEL,1.0_pREAL,misc_optional(weighted,.true.))
math_sym33to6 = [(w(i)*m33(MAPNYE(1,i),MAPNYE(2,i)),i=1,6)]
@@ -725,15 +725,15 @@ end function math_sym33to6
!--------------------------------------------------------------------------------------------------
pure function math_6toSym33(v6,weighted)
- real(pReal), dimension(3,3) :: math_6toSym33
- real(pReal), dimension(6), intent(in) :: v6 !< 6 vector
+ real(pREAL), dimension(3,3) :: math_6toSym33
+ real(pREAL), dimension(6), intent(in) :: v6 !< 6 vector
logical, optional, intent(in) :: weighted !< weight according to Mandel (.true. by default)
- real(pReal), dimension(6) :: w
+ real(pREAL), dimension(6) :: w
integer :: i
- w = merge(INVNRMMANDEL,1.0_pReal,misc_optional(weighted,.true.))
+ 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)
@@ -748,8 +748,8 @@ end function math_6toSym33
!--------------------------------------------------------------------------------------------------
pure function math_3333to99(m3333)
- real(pReal), dimension(9,9) :: math_3333to99
- real(pReal), dimension(3,3,3,3), intent(in) :: m3333
+ real(pREAL), dimension(9,9) :: math_3333to99
+ real(pREAL), dimension(3,3,3,3), intent(in) :: m3333
integer :: i,j
@@ -770,8 +770,8 @@ end function math_3333to99
!--------------------------------------------------------------------------------------------------
pure function math_99to3333(m99)
- real(pReal), dimension(3,3,3,3) :: math_99to3333
- real(pReal), dimension(9,9), intent(in) :: m99
+ real(pREAL), dimension(3,3,3,3) :: math_99to3333
+ real(pREAL), dimension(9,9), intent(in) :: m99
integer :: i,j
@@ -795,15 +795,15 @@ end function math_99to3333
!--------------------------------------------------------------------------------------------------
pure function math_sym3333to66(m3333,weighted)
- real(pReal), dimension(6,6) :: math_sym3333to66
- real(pReal), dimension(3,3,3,3), intent(in) :: m3333 !< symmetric 3x3x3x3 matrix (no internal check)
+ real(pREAL), dimension(6,6) :: math_sym3333to66
+ real(pREAL), dimension(3,3,3,3), intent(in) :: m3333 !< symmetric 3x3x3x3 matrix (no internal check)
logical, optional, intent(in) :: weighted !< weight according to Mandel (.true. by default)
- real(pReal), dimension(6) :: w
+ real(pREAL), dimension(6) :: w
integer :: i,j
- w = merge(NRMMANDEL,1.0_pReal,misc_optional(weighted,.true.))
+ w = merge(NRMMANDEL,1.0_pREAL,misc_optional(weighted,.true.))
#ifndef __INTEL_COMPILER
do concurrent(i=1:6, j=1:6)
@@ -824,15 +824,15 @@ end function math_sym3333to66
!--------------------------------------------------------------------------------------------------
pure function math_66toSym3333(m66,weighted)
- real(pReal), dimension(3,3,3,3) :: math_66toSym3333
- real(pReal), dimension(6,6), intent(in) :: m66 !< 6x6 matrix
+ real(pREAL), dimension(3,3,3,3) :: math_66toSym3333
+ real(pREAL), dimension(6,6), intent(in) :: m66 !< 6x6 matrix
logical, optional, intent(in) :: weighted !< weight according to Mandel (.true. by default)
- real(pReal), dimension(6) :: w
+ real(pREAL), dimension(6) :: w
integer :: i,j
- w = merge(INVNRMMANDEL,1.0_pReal,misc_optional(weighted,.true.))
+ 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)
@@ -849,8 +849,8 @@ end function math_66toSym3333
!--------------------------------------------------------------------------------------------------
pure function math_Voigt6to33_stress(sigma_tilde) result(sigma)
- real(pReal), dimension(3,3) :: sigma
- real(pReal), dimension(6), intent(in) :: sigma_tilde
+ real(pREAL), dimension(3,3) :: sigma
+ real(pREAL), dimension(6), intent(in) :: sigma_tilde
sigma = reshape([sigma_tilde(1), sigma_tilde(6), sigma_tilde(5), &
@@ -865,13 +865,13 @@ end function math_Voigt6to33_stress
!--------------------------------------------------------------------------------------------------
pure function math_Voigt6to33_strain(epsilon_tilde) result(epsilon)
- real(pReal), dimension(3,3) :: epsilon
- real(pReal), dimension(6), intent(in) :: epsilon_tilde
+ real(pREAL), dimension(3,3) :: epsilon
+ real(pREAL), dimension(6), intent(in) :: epsilon_tilde
- epsilon = reshape([ epsilon_tilde(1), 0.5_pReal*epsilon_tilde(6), 0.5_pReal*epsilon_tilde(5), &
- 0.5_pReal*epsilon_tilde(6), epsilon_tilde(2), 0.5_pReal*epsilon_tilde(4), &
- 0.5_pReal*epsilon_tilde(5), 0.5_pReal*epsilon_tilde(4), epsilon_tilde(3)],[3,3])
+ epsilon = reshape([ epsilon_tilde(1), 0.5_pREAL*epsilon_tilde(6), 0.5_pREAL*epsilon_tilde(5), &
+ 0.5_pREAL*epsilon_tilde(6), epsilon_tilde(2), 0.5_pREAL*epsilon_tilde(4), &
+ 0.5_pREAL*epsilon_tilde(5), 0.5_pREAL*epsilon_tilde(4), epsilon_tilde(3)],[3,3])
end function math_Voigt6to33_strain
@@ -881,8 +881,8 @@ end function math_Voigt6to33_strain
!--------------------------------------------------------------------------------------------------
pure function math_33toVoigt6_stress(sigma) result(sigma_tilde)
- real(pReal), dimension(6) :: sigma_tilde
- real(pReal), dimension(3,3), intent(in) :: sigma
+ real(pREAL), dimension(6) :: sigma_tilde
+ real(pREAL), dimension(3,3), intent(in) :: sigma
sigma_tilde = [sigma(1,1), sigma(2,2), sigma(3,3), &
@@ -896,12 +896,12 @@ end function math_33toVoigt6_stress
!--------------------------------------------------------------------------------------------------
pure function math_33toVoigt6_strain(epsilon) result(epsilon_tilde)
- real(pReal), dimension(6) :: epsilon_tilde
- real(pReal), dimension(3,3), intent(in) :: epsilon
+ real(pREAL), dimension(6) :: epsilon_tilde
+ real(pREAL), dimension(3,3), intent(in) :: epsilon
epsilon_tilde = [ epsilon(1,1), epsilon(2,2), epsilon(3,3), &
- 2.0_pReal*epsilon(3,2), 2.0_pReal*epsilon(3,1), 2.0_pReal*epsilon(1,2)]
+ 2.0_pREAL*epsilon(3,2), 2.0_pREAL*epsilon(3,1), 2.0_pREAL*epsilon(1,2)]
end function math_33toVoigt6_strain
@@ -912,8 +912,8 @@ end function math_33toVoigt6_strain
!--------------------------------------------------------------------------------------------------
pure function math_Voigt66to3333_stiffness(C_tilde) result(C)
- real(pReal), dimension(3,3,3,3) :: C
- real(pReal), dimension(6,6), intent(in) :: C_tilde
+ real(pREAL), dimension(3,3,3,3) :: C
+ real(pREAL), dimension(6,6), intent(in) :: C_tilde
integer :: i,j
@@ -933,8 +933,8 @@ end function math_Voigt66to3333_stiffness
!--------------------------------------------------------------------------------------------------
pure function math_3333toVoigt66_stiffness(C) result(C_tilde)
- real(pReal), dimension(6,6) :: C_tilde
- real(pReal), dimension(3,3,3,3), intent(in) :: C
+ real(pREAL), dimension(6,6) :: C_tilde
+ real(pREAL), dimension(3,3,3,3), intent(in) :: C
integer :: i,j
@@ -957,15 +957,15 @@ end function math_3333toVoigt66_stiffness
!--------------------------------------------------------------------------------------------------
impure elemental subroutine math_normal(x,mu,sigma)
- real(pReal), intent(out) :: x
- real(pReal), intent(in), optional :: mu, sigma
+ real(pREAL), intent(out) :: x
+ real(pREAL), intent(in), optional :: mu, sigma
- real(pReal), dimension(2) :: rnd
+ real(pREAL), dimension(2) :: rnd
call random_number(rnd)
- 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)))
+ 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
@@ -975,13 +975,13 @@ end subroutine math_normal
!--------------------------------------------------------------------------------------------------
pure subroutine math_eigh(w,v,error,m)
- real(pReal), dimension(:,:), intent(in) :: m !< quadratic matrix to compute eigenvectors and values of
- real(pReal), dimension(size(m,1)), intent(out) :: w !< eigenvalues
- real(pReal), dimension(size(m,1),size(m,1)), intent(out) :: v !< eigenvectors
+ real(pREAL), dimension(:,:), intent(in) :: m !< quadratic matrix to compute eigenvectors and values of
+ real(pREAL), dimension(size(m,1)), intent(out) :: w !< eigenvalues
+ real(pREAL), dimension(size(m,1),size(m,1)), intent(out) :: v !< eigenvectors
logical, intent(out) :: error
integer :: ierr
- real(pReal), dimension(size(m,1)**2) :: work
+ real(pREAL), dimension(size(m,1)**2) :: work
v = m ! copy matrix to input (doubles as output) array
@@ -1000,11 +1000,11 @@ end subroutine math_eigh
!--------------------------------------------------------------------------------------------------
pure subroutine math_eigh33(w,v,m)
- real(pReal), dimension(3,3),intent(in) :: m !< 3x3 matrix to compute eigenvectors and values of
- real(pReal), dimension(3), intent(out) :: w !< eigenvalues
- real(pReal), dimension(3,3),intent(out) :: v !< eigenvectors
+ real(pREAL), dimension(3,3),intent(in) :: m !< 3x3 matrix to compute eigenvectors and values of
+ real(pREAL), dimension(3), intent(out) :: w !< eigenvalues
+ real(pREAL), dimension(3,3),intent(out) :: v !< eigenvectors
- real(pReal) :: T, U, norm, threshold
+ real(pREAL) :: T, U, norm, threshold
logical :: error
@@ -1016,7 +1016,7 @@ pure subroutine math_eigh33(w,v,m)
T = maxval(abs(w))
U = max(T, T**2)
- threshold = sqrt(5.68e-14_pReal * U**2)
+ threshold = sqrt(5.68e-14_pREAL * U**2)
#ifndef __INTEL_LLVM_COMPILER
v(1:3,1) = [m(1,3)*w(1) + v(1,2), &
@@ -1059,32 +1059,32 @@ end subroutine math_eigh33
!--------------------------------------------------------------------------------------------------
pure function math_rotationalPart(F) result(R)
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
F ! deformation gradient
- real(pReal), dimension(3,3) :: &
+ real(pREAL), dimension(3,3) :: &
C, & ! right Cauchy-Green tensor
R ! rotational part
- real(pReal), dimension(3) :: &
+ real(pREAL), dimension(3) :: &
lambda, & ! principal stretches
I_C, & ! invariants of C
I_U ! invariants of U
- real(pReal), dimension(2) :: &
+ real(pREAL), dimension(2) :: &
I_F ! first two invariants of F
- real(pReal) :: x,Phi
+ real(pREAL) :: x,Phi
C = matmul(transpose(F),F)
I_C = math_invariantsSym33(C)
- I_F = [math_trace33(F), 0.5_pReal*(math_trace33(F)**2 - math_trace33(matmul(F,F)))]
+ I_F = [math_trace33(F), 0.5_pREAL*(math_trace33(F)**2 - math_trace33(matmul(F,F)))]
- x = math_clip(I_C(1)**2 -3.0_pReal*I_C(2),0.0_pReal)**(3.0_pReal/2.0_pReal)
+ x = math_clip(I_C(1)**2 -3.0_pREAL*I_C(2),0.0_pREAL)**(3.0_pREAL/2.0_pREAL)
if (dNeq0(x)) then
- Phi = acos(math_clip((I_C(1)**3 -4.5_pReal*I_C(1)*I_C(2) +13.5_pReal*I_C(3))/x,-1.0_pReal,1.0_pReal))
- lambda = I_C(1) +(2.0_pReal * sqrt(math_clip(I_C(1)**2-3.0_pReal*I_C(2),0.0_pReal))) &
- *cos((Phi-TAU*[1.0_pReal,2.0_pReal,3.0_pReal])/3.0_pReal)
- lambda = sqrt(math_clip(lambda,0.0_pReal)/3.0_pReal)
+ Phi = acos(math_clip((I_C(1)**3 -4.5_pREAL*I_C(1)*I_C(2) +13.5_pREAL*I_C(3))/x,-1.0_pREAL,1.0_pREAL))
+ lambda = I_C(1) +(2.0_pREAL * sqrt(math_clip(I_C(1)**2-3.0_pREAL*I_C(2),0.0_pREAL))) &
+ *cos((Phi-TAU*[1.0_pREAL,2.0_pREAL,3.0_pREAL])/3.0_pREAL)
+ lambda = sqrt(math_clip(lambda,0.0_pREAL)/3.0_pREAL)
else
- lambda = sqrt(I_C(1)/3.0_pReal)
+ lambda = sqrt(I_C(1)/3.0_pREAL)
end if
I_U = [sum(lambda), lambda(1)*lambda(2)+lambda(2)*lambda(3)+lambda(3)*lambda(1), product(lambda)]
@@ -1094,7 +1094,7 @@ pure function math_rotationalPart(F) result(R)
- I_U(1)*I_F(1) * transpose(F) &
+ I_U(1) * transpose(matmul(F,F)) &
- matmul(F,C)
- R = R*math_det33(R)**(-1.0_pReal/3.0_pReal)
+ R = R*math_det33(R)**(-1.0_pREAL/3.0_pREAL)
end function math_rotationalPart
@@ -1105,17 +1105,17 @@ end function math_rotationalPart
!--------------------------------------------------------------------------------------------------
pure function math_eigvalsh(m)
- real(pReal), dimension(:,:), intent(in) :: m !< symmetric matrix to compute eigenvalues of
- real(pReal), dimension(size(m,1)) :: math_eigvalsh
+ real(pREAL), dimension(:,:), intent(in) :: m !< symmetric matrix to compute eigenvalues of
+ real(pREAL), dimension(size(m,1)) :: math_eigvalsh
- real(pReal), dimension(size(m,1),size(m,1)) :: m_
+ real(pREAL), dimension(size(m,1),size(m,1)) :: m_
integer :: ierr
- real(pReal), dimension(size(m,1)**2) :: work
+ real(pREAL), dimension(size(m,1)**2) :: work
m_ = m ! m_ will be destroyed
call dsyev('N','U',size(m,1),m_,size(m,1),math_eigvalsh,work,size(work),ierr)
- if (ierr /= 0) math_eigvalsh = IEEE_value(1.0_pReal,IEEE_quiet_NaN)
+ if (ierr /= 0) math_eigvalsh = IEEE_value(1.0_pREAL,IEEE_quiet_NaN)
end function math_eigvalsh
@@ -1129,30 +1129,30 @@ end function math_eigvalsh
!--------------------------------------------------------------------------------------------------
pure function math_eigvalsh33(m)
- real(pReal), intent(in), dimension(3,3) :: m !< 3x3 symmetric matrix to compute eigenvalues of
- real(pReal), dimension(3) :: math_eigvalsh33,I
- real(pReal) :: P, Q, rho, phi
- real(pReal), parameter :: TOL=1.e-14_pReal
+ real(pREAL), intent(in), dimension(3,3) :: m !< 3x3 symmetric matrix to compute eigenvalues of
+ real(pREAL), dimension(3) :: math_eigvalsh33,I
+ real(pREAL) :: P, Q, rho, phi
+ real(pREAL), parameter :: TOL=1.e-14_pREAL
I = math_invariantsSym33(m) ! invariants are coefficients in characteristic polynomial apart for the sign of c0 and c2 in http://arxiv.org/abs/physics/0610206
- P = I(2)-I(1)**2/3.0_pReal ! different from http://arxiv.org/abs/physics/0610206 (this formulation was in DAMASK)
- Q = product(I(1:2))/3.0_pReal &
- - 2.0_pReal/27.0_pReal*I(1)**3 &
+ P = I(2)-I(1)**2/3.0_pREAL ! different from http://arxiv.org/abs/physics/0610206 (this formulation was in DAMASK)
+ Q = product(I(1:2))/3.0_pREAL &
+ - 2.0_pREAL/27.0_pREAL*I(1)**3 &
- I(3) ! different from http://arxiv.org/abs/physics/0610206 (this formulation was in DAMASK)
if (all(abs([P,Q]) < TOL)) then
math_eigvalsh33 = math_eigvalsh(m)
else
- rho=sqrt(-3.0_pReal*P**3)/9.0_pReal
- phi=acos(math_clip(-Q/rho*0.5_pReal,-1.0_pReal,1.0_pReal))
- math_eigvalsh33 = 2.0_pReal*rho**(1.0_pReal/3.0_pReal)* &
- [cos( phi /3.0_pReal), &
- cos((phi+TAU)/3.0_pReal), &
- cos((phi+2.0_pReal*TAU)/3.0_pReal) &
+ rho=sqrt(-3.0_pREAL*P**3)/9.0_pREAL
+ phi=acos(math_clip(-Q/rho*0.5_pREAL,-1.0_pREAL,1.0_pREAL))
+ math_eigvalsh33 = 2.0_pREAL*rho**(1.0_pREAL/3.0_pREAL)* &
+ [cos( phi /3.0_pREAL), &
+ cos((phi+TAU)/3.0_pREAL), &
+ cos((phi+2.0_pREAL*TAU)/3.0_pREAL) &
] &
- + I(1)/3.0_pReal
+ + I(1)/3.0_pREAL
end if
end function math_eigvalsh33
@@ -1163,8 +1163,8 @@ end function math_eigvalsh33
!--------------------------------------------------------------------------------------------------
pure function math_invariantsSym33(m)
- real(pReal), dimension(3,3), intent(in) :: m
- real(pReal), dimension(3) :: math_invariantsSym33
+ real(pREAL), dimension(3,3), intent(in) :: m
+ real(pREAL), dimension(3) :: math_invariantsSym33
math_invariantsSym33(1) = math_trace33(m)
@@ -1225,17 +1225,17 @@ end function math_multinomial
!--------------------------------------------------------------------------------------------------
!> @brief volume of tetrahedron given by four vertices
!--------------------------------------------------------------------------------------------------
-real(pReal) pure function math_volTetrahedron(v1,v2,v3,v4)
+real(pREAL) pure function math_volTetrahedron(v1,v2,v3,v4)
- real(pReal), dimension (3), intent(in) :: v1,v2,v3,v4
- real(pReal), dimension (3,3) :: m
+ real(pREAL), dimension (3), intent(in) :: v1,v2,v3,v4
+ real(pREAL), dimension (3,3) :: m
m(1:3,1) = v1-v2
m(1:3,2) = v1-v3
m(1:3,3) = v1-v4
- math_volTetrahedron = abs(math_det33(m))/6.0_pReal
+ math_volTetrahedron = abs(math_det33(m))/6.0_pREAL
end function math_volTetrahedron
@@ -1243,12 +1243,12 @@ end function math_volTetrahedron
!--------------------------------------------------------------------------------------------------
!> @brief area of triangle given by three vertices
!--------------------------------------------------------------------------------------------------
-real(pReal) pure function math_areaTriangle(v1,v2,v3)
+real(pREAL) pure function math_areaTriangle(v1,v2,v3)
- real(pReal), dimension (3), intent(in) :: v1,v2,v3
+ real(pREAL), dimension (3), intent(in) :: v1,v2,v3
- math_areaTriangle = 0.5_pReal * norm2(math_cross(v1-v2,v1-v3))
+ math_areaTriangle = 0.5_pREAL * norm2(math_cross(v1-v2,v1-v3))
end function math_areaTriangle
@@ -1256,10 +1256,10 @@ end function math_areaTriangle
!--------------------------------------------------------------------------------------------------
!> @brief Limit a scalar value to a certain range (either one or two sided).
!--------------------------------------------------------------------------------------------------
-real(pReal) pure elemental function math_clip(a, left, right)
+real(pREAL) pure elemental function math_clip(a, left, right)
- real(pReal), intent(in) :: a
- real(pReal), intent(in), optional :: left, right
+ real(pREAL), intent(in) :: a
+ real(pREAL), intent(in), optional :: left, right
math_clip = a
@@ -1285,30 +1285,30 @@ subroutine selfTest()
integer, dimension(5) :: range_out_ = [1,2,3,4,5]
integer, dimension(3) :: ijk
- real(pReal) :: det
- real(pReal), dimension(3) :: v3_1,v3_2,v3_3,v3_4
- real(pReal), dimension(6) :: v6
- real(pReal), dimension(9) :: v9
- real(pReal), dimension(3,3) :: t33,t33_2
- real(pReal), dimension(6,6) :: t66
- real(pReal), dimension(9,9) :: t99,t99_2
- real(pReal), dimension(:,:), &
+ real(pREAL) :: det
+ real(pREAL), dimension(3) :: v3_1,v3_2,v3_3,v3_4
+ real(pREAL), dimension(6) :: v6
+ real(pREAL), dimension(9) :: v9
+ real(pREAL), dimension(3,3) :: t33,t33_2
+ real(pREAL), dimension(6,6) :: t66
+ real(pREAL), dimension(9,9) :: t99,t99_2
+ real(pREAL), dimension(:,:), &
allocatable :: txx,txx_2
- real(pReal) :: r
+ real(pREAL) :: r
integer :: d
logical :: e
- if (any(abs([1.0_pReal,2.0_pReal,2.0_pReal,3.0_pReal,3.0_pReal,3.0_pReal] - &
- math_expand([1.0_pReal,2.0_pReal,3.0_pReal],[1,2,3,0])) > tol_math_check)) &
+ if (any(abs([1.0_pREAL,2.0_pREAL,2.0_pREAL,3.0_pREAL,3.0_pREAL,3.0_pREAL] - &
+ math_expand([1.0_pREAL,2.0_pREAL,3.0_pREAL],[1,2,3,0])) > tol_math_check)) &
error stop 'math_expand [1,2,3] by [1,2,3,0] => [1,2,2,3,3,3]'
- if (any(abs([1.0_pReal,2.0_pReal,2.0_pReal] - &
- math_expand([1.0_pReal,2.0_pReal,3.0_pReal],[1,2])) > tol_math_check)) &
+ if (any(abs([1.0_pREAL,2.0_pREAL,2.0_pREAL] - &
+ math_expand([1.0_pREAL,2.0_pREAL,3.0_pREAL],[1,2])) > tol_math_check)) &
error stop 'math_expand [1,2,3] by [1,2] => [1,2,2]'
- if (any(abs([1.0_pReal,2.0_pReal,2.0_pReal,1.0_pReal,1.0_pReal,1.0_pReal] - &
- math_expand([1.0_pReal,2.0_pReal],[1,2,3])) > tol_math_check)) &
+ if (any(abs([1.0_pREAL,2.0_pREAL,2.0_pREAL,1.0_pREAL,1.0_pREAL,1.0_pREAL] - &
+ math_expand([1.0_pREAL,2.0_pREAL],[1,2,3])) > tol_math_check)) &
error stop 'math_expand [1,2] by [1,2,3] => [1,2,2,1,1,1]'
call math_sort(sort_in_,1,3,2)
@@ -1320,7 +1320,7 @@ subroutine selfTest()
if (any(dNeq(math_exp33(math_I3,0),math_I3))) &
error stop 'math_exp33(math_I3,1)'
- if (any(dNeq(math_exp33(math_I3,128),exp(1.0_pReal)*math_I3))) &
+ if (any(dNeq(math_exp33(math_I3,128),exp(1.0_pREAL)*math_I3))) &
error stop 'math_exp33(math_I3,128)'
call random_number(v9)
@@ -1336,10 +1336,10 @@ subroutine selfTest()
error stop 'math_sym33to6/math_6toSym33'
call random_number(t66)
- if (any(dNeq(math_sym3333to66(math_66toSym3333(t66)),t66,1.0e-15_pReal))) &
+ if (any(dNeq(math_sym3333to66(math_66toSym3333(t66)),t66,1.0e-15_pREAL))) &
error stop 'math_sym3333to66/math_66toSym3333'
- if (any(dNeq(math_3333toVoigt66_stiffness(math_Voigt66to3333_stiffness(t66)),t66,1.0e-15_pReal))) &
+ if (any(dNeq(math_3333toVoigt66_stiffness(math_Voigt66to3333_stiffness(t66)),t66,1.0e-15_pREAL))) &
error stop 'math_3333toVoigt66/math_Voigt66to3333'
call random_number(v6)
@@ -1351,12 +1351,12 @@ subroutine selfTest()
call random_number(v3_3)
call random_number(v3_4)
- if (dNeq(abs(dot_product(math_cross(v3_1-v3_4,v3_2-v3_4),v3_3-v3_4))/6.0_pReal, &
- math_volTetrahedron(v3_1,v3_2,v3_3,v3_4),tol=1.0e-12_pReal)) &
+ if (dNeq(abs(dot_product(math_cross(v3_1-v3_4,v3_2-v3_4),v3_3-v3_4))/6.0_pREAL, &
+ math_volTetrahedron(v3_1,v3_2,v3_3,v3_4),tol=1.0e-12_pREAL)) &
error stop 'math_volTetrahedron'
call random_number(t33)
- if (dNeq(math_det33(math_symmetric33(t33)),math_detSym33(math_symmetric33(t33)),tol=1.0e-12_pReal)) &
+ if (dNeq(math_det33(math_symmetric33(t33)),math_detSym33(math_symmetric33(t33)),tol=1.0e-12_pREAL)) &
error stop 'math_det33/math_detSym33'
if (any(dNeq(t33+transpose(t33),math_mul3333xx33(math_identity4th(),t33+transpose(t33))))) &
@@ -1365,34 +1365,34 @@ subroutine selfTest()
if (any(dNeq0(math_eye(3),math_inv33(math_I3)))) &
error stop 'math_inv33(math_I3)'
- do while(abs(math_det33(t33))<1.0e-9_pReal)
+ do while(abs(math_det33(t33))<1.0e-9_pREAL)
call random_number(t33)
end do
- if (any(dNeq0(matmul(t33,math_inv33(t33)) - math_eye(3),tol=1.0e-8_pReal))) &
+ if (any(dNeq0(matmul(t33,math_inv33(t33)) - math_eye(3),tol=1.0e-8_pREAL))) &
error stop 'math_inv33'
call math_invert33(t33_2,det,e,t33)
- if (any(dNeq0(matmul(t33,t33_2) - math_eye(3),tol=1.0e-9_pReal)) .or. e) &
+ if (any(dNeq0(matmul(t33,t33_2) - math_eye(3),tol=1.0e-9_pREAL)) .or. e) &
error stop 'math_invert33: T:T^-1 != I'
- if (dNeq(det,math_det33(t33),tol=1.0e-12_pReal)) &
+ if (dNeq(det,math_det33(t33),tol=1.0e-12_pREAL)) &
error stop 'math_invert33 (determinant)'
call math_invert(t33_2,e,t33)
- if (any(dNeq0(matmul(t33,t33_2) - math_eye(3),tol=1.0e-9_pReal)) .or. e) &
+ if (any(dNeq0(matmul(t33,t33_2) - math_eye(3),tol=1.0e-9_pREAL)) .or. e) &
error stop 'math_invert t33'
- do while(math_det33(t33)<1.0e-2_pReal) ! O(det(F)) = 1
+ do while(math_det33(t33)<1.0e-2_pREAL) ! O(det(F)) = 1
call random_number(t33)
end do
t33_2 = math_rotationalPart(transpose(t33))
t33 = math_rotationalPart(t33)
- if (any(dNeq0(matmul(t33_2,t33) - math_I3,tol=1.0e-10_pReal))) &
+ if (any(dNeq0(matmul(t33_2,t33) - math_I3,tol=1.0e-10_pREAL))) &
error stop 'math_rotationalPart (forward-backward)'
- if (dNeq(1.0_pReal,math_det33(math_rotationalPart(t33)),tol=1.0e-10_pReal)) &
+ if (dNeq(1.0_pREAL,math_det33(math_rotationalPart(t33)),tol=1.0e-10_pREAL)) &
error stop 'math_rotationalPart (determinant)'
call random_number(r)
- d = int(r*5.0_pReal) + 1
+ d = int(r*5.0_pREAL) + 1
txx = math_eye(d)
allocate(txx_2(d,d))
call math_invert(txx_2,e,txx)
@@ -1400,10 +1400,10 @@ subroutine selfTest()
error stop 'math_invert(txx)/math_eye'
call math_invert(t99_2,e,t99) ! not sure how likely it is that we get a singular matrix
- if (any(dNeq0(matmul(t99_2,t99)-math_eye(9),tol=1.0e-9_pReal)) .or. e) &
+ if (any(dNeq0(matmul(t99_2,t99)-math_eye(9),tol=1.0e-9_pREAL)) .or. e) &
error stop 'math_invert(t99)'
- if (any(dNeq(math_clip([4.0_pReal,9.0_pReal],5.0_pReal,6.5_pReal),[5.0_pReal,6.5_pReal]))) &
+ if (any(dNeq(math_clip([4.0_pREAL,9.0_pREAL],5.0_pREAL,6.5_pREAL),[5.0_pREAL,6.5_pREAL]))) &
error stop 'math_clip'
if (math_factorial(10) /= 3628800) &
@@ -1415,35 +1415,35 @@ subroutine selfTest()
if (math_multinomial([1,2,3,4]) /= 12600) &
error stop 'math_multinomial'
- ijk = cshift([1,2,3],int(r*1.0e2_pReal))
- if (dNeq(math_LeviCivita(ijk(1),ijk(2),ijk(3)),+1.0_pReal)) &
+ ijk = cshift([1,2,3],int(r*1.0e2_pREAL))
+ if (dNeq(math_LeviCivita(ijk(1),ijk(2),ijk(3)),+1.0_pREAL)) &
error stop 'math_LeviCivita(even)'
- ijk = cshift([3,2,1],int(r*2.0e2_pReal))
- if (dNeq(math_LeviCivita(ijk(1),ijk(2),ijk(3)),-1.0_pReal)) &
+ ijk = cshift([3,2,1],int(r*2.0e2_pREAL))
+ if (dNeq(math_LeviCivita(ijk(1),ijk(2),ijk(3)),-1.0_pREAL)) &
error stop 'math_LeviCivita(odd)'
- ijk = cshift([2,2,1],int(r*2.0e2_pReal))
+ ijk = cshift([2,2,1],int(r*2.0e2_pREAL))
if (dNeq0(math_LeviCivita(ijk(1),ijk(2),ijk(3)))) &
error stop 'math_LeviCivita'
normal_distribution: block
integer, parameter :: N = 1000000
- real(pReal), dimension(:), allocatable :: r
- real(pReal) :: mu, sigma
+ real(pREAL), dimension(:), allocatable :: r
+ real(pREAL) :: mu, sigma
allocate(r(N))
call random_number(mu)
call random_number(sigma)
- sigma = 1.0_pReal + sigma*5.0_pReal
- mu = (mu-0.5_pReal)*10_pReal
+ sigma = 1.0_pREAL + sigma*5.0_pREAL
+ mu = (mu-0.5_pREAL)*10_pREAL
call math_normal(r,mu,sigma)
- if (abs(mu -sum(r)/real(N,pReal))>5.0e-2_pReal) &
+ if (abs(mu -sum(r)/real(N,pREAL))>5.0e-2_pREAL) &
error stop 'math_normal(mu)'
- mu = sum(r)/real(N,pReal)
- if (abs(sigma**2 -1.0_pReal/real(N-1,pReal) * sum((r-mu)**2))/sigma > 5.0e-2_pReal) &
+ mu = sum(r)/real(N,pREAL)
+ if (abs(sigma**2 -1.0_pREAL/real(N-1,pREAL) * sum((r-mu)**2))/sigma > 5.0e-2_pREAL) &
error stop 'math_normal(sigma)'
end block normal_distribution
diff --git a/src/mesh/DAMASK_mesh.f90 b/src/mesh/DAMASK_mesh.f90
index 29014e49f..4da6ff94c 100644
--- a/src/mesh/DAMASK_mesh.f90
+++ b/src/mesh/DAMASK_mesh.f90
@@ -23,7 +23,7 @@ program DAMASK_mesh
implicit none(type,external)
type :: tLoadCase
- real(pReal) :: time = 0.0_pReal !< length of increment
+ real(pREAL) :: time = 0.0_pREAL !< length of increment
integer :: incs = 0, & !< number of increments
outputfrequency = 1 !< frequency of result writes
logical :: followFormerTrajectory = .true. !< follow trajectory of former loadcase
@@ -43,12 +43,12 @@ program DAMASK_mesh
! loop variables, convergence etc.
integer, parameter :: &
subStepFactor = 2 !< for each substep, divide the last time increment by 2.0
- real(pReal) :: &
- time = 0.0_pReal, & !< elapsed time
- time0 = 0.0_pReal, & !< begin of interval
- timeinc = 0.0_pReal, & !< current time interval
- timeIncOld = 0.0_pReal, & !< previous time interval
- remainingLoadCaseTime = 0.0_pReal !< remaining time of current load case
+ real(pREAL) :: &
+ time = 0.0_pREAL, & !< elapsed time
+ time0 = 0.0_pREAL, & !< begin of interval
+ timeinc = 0.0_pREAL, & !< current time interval
+ timeIncOld = 0.0_pREAL, & !< previous time interval
+ remainingLoadCaseTime = 0.0_pREAL !< remaining time of current load case
logical :: &
guess, & !< guess along former trajectory
stagIterate
@@ -67,8 +67,8 @@ program DAMASK_mesh
component
type(tDict), pointer :: &
num_mesh
- character(len=pStringLen), dimension(:), allocatable :: fileContent
- character(len=pStringLen) :: &
+ character(len=pSTRLEN), dimension(:), allocatable :: fileContent
+ character(len=pSTRLEN) :: &
incInfo, &
loadcase_string
integer :: &
@@ -109,9 +109,9 @@ program DAMASK_mesh
line = fileContent(l)
if (IO_isBlank(line)) cycle ! skip empty lines
- chunkPos = IO_stringPos(line)
+ chunkPos = IO_strPos(line)
do i = 1, chunkPos(1) ! reading compulsory parameters for loadcase
- select case (IO_stringValue(line,chunkPos,i))
+ select case (IO_strValue(line,chunkPos,i))
case('$Loadcase')
N_def = N_def + 1
end select
@@ -140,7 +140,7 @@ program DAMASK_mesh
end select
end do
do component = 1, loadCases(i)%fieldBC(1)%nComponents
- allocate(loadCases(i)%fieldBC(1)%componentBC(component)%Value(mesh_Nboundaries), source = 0.0_pReal)
+ allocate(loadCases(i)%fieldBC(1)%componentBC(component)%Value(mesh_Nboundaries), source = 0.0_pREAL)
allocate(loadCases(i)%fieldBC(1)%componentBC(component)%Mask (mesh_Nboundaries), source = .false.)
end do
end do
@@ -151,9 +151,9 @@ program DAMASK_mesh
line = fileContent(l)
if (IO_isBlank(line)) cycle ! skip empty lines
- chunkPos = IO_stringPos(line)
+ chunkPos = IO_strPos(line)
do i = 1, chunkPos(1)
- select case (IO_stringValue(line,chunkPos,i))
+ select case (IO_strValue(line,chunkPos,i))
!--------------------------------------------------------------------------------------------------
! loadcase information
case('$Loadcase')
@@ -166,7 +166,7 @@ program DAMASK_mesh
end do
if (currentFaceSet < 0) call IO_error(error_ID = 837, ext_msg = 'invalid BC')
case('t')
- loadCases(currentLoadCase)%time = IO_floatValue(line,chunkPos,i+1)
+ loadCases(currentLoadCase)%time = IO_realValue(line,chunkPos,i+1)
case('N')
loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1)
case('f_out')
@@ -177,7 +177,7 @@ program DAMASK_mesh
!--------------------------------------------------------------------------------------------------
! boundary condition information
case('X','Y','Z')
- select case(IO_stringValue(line,chunkPos,i))
+ select case(IO_strValue(line,chunkPos,i))
case('X')
ID = COMPONENT_MECH_X_ID
case('Y')
@@ -191,7 +191,7 @@ program DAMASK_mesh
loadCases(currentLoadCase)%fieldBC(1)%componentBC(component)%Mask (currentFaceSet) = &
.true.
loadCases(currentLoadCase)%fieldBC(1)%componentBC(component)%Value(currentFaceSet) = &
- IO_floatValue(line,chunkPos,i+1)
+ IO_realValue(line,chunkPos,i+1)
end if
end do
end select
@@ -240,7 +240,7 @@ program DAMASK_mesh
print'(/,1x,a)', '... writing initial configuration to file .................................'
flush(IO_STDOUT)
- call materialpoint_result(0,0.0_pReal)
+ call materialpoint_result(0,0.0_pREAL)
loadCaseLooping: do currentLoadCase = 1, size(loadCases)
time0 = time ! load case start time
@@ -252,8 +252,8 @@ program DAMASK_mesh
!--------------------------------------------------------------------------------------------------
! forwarding time
timeIncOld = timeinc ! last timeinc that brought former inc to an end
- timeinc = loadCases(currentLoadCase)%time/real(loadCases(currentLoadCase)%incs,pReal)
- timeinc = timeinc * real(subStepFactor,pReal)**real(-cutBackLevel,pReal) ! depending on cut back level, decrease time step
+ timeinc = loadCases(currentLoadCase)%time/real(loadCases(currentLoadCase)%incs,pREAL)
+ timeinc = timeinc * real(subStepFactor,pREAL)**real(-cutBackLevel,pREAL) ! depending on cut back level, decrease time step
stepFraction = 0 ! fraction scaled by stepFactor**cutLevel
subStepLooping: do while (stepFraction < subStepFactor**cutBackLevel)
@@ -298,7 +298,7 @@ program DAMASK_mesh
stepFraction = (stepFraction - 1) * subStepFactor ! adjust to new denominator
cutBackLevel = cutBackLevel + 1
time = time - timeinc ! rewind time
- timeinc = timeinc/2.0_pReal
+ timeinc = timeinc/2.0_pREAL
print'(/,1x,a)', 'cutting back'
else ! default behavior, exit if spectral solver does not converge
if (worldrank == 0) close(statUnit)
diff --git a/src/mesh/FEM_quadrature.f90 b/src/mesh/FEM_quadrature.f90
index 518cd1a4e..891e0be0d 100644
--- a/src/mesh/FEM_quadrature.f90
+++ b/src/mesh/FEM_quadrature.f90
@@ -10,23 +10,23 @@ module FEM_quadrature
integer, parameter :: &
maxOrder = 5 !< maximum integration order
- real(pReal), dimension(2,3), parameter :: &
- triangle = reshape([-1.0_pReal, -1.0_pReal, &
- 1.0_pReal, -1.0_pReal, &
- -1.0_pReal, 1.0_pReal], shape=[2,3])
- real(pReal), dimension(3,4), parameter :: &
- tetrahedron = reshape([-1.0_pReal, -1.0_pReal, -1.0_pReal, &
- 1.0_pReal, -1.0_pReal, -1.0_pReal, &
- -1.0_pReal, 1.0_pReal, -1.0_pReal, &
- -1.0_pReal, -1.0_pReal, 1.0_pReal], shape=[3,4])
+ real(pREAL), dimension(2,3), parameter :: &
+ triangle = reshape([-1.0_pREAL, -1.0_pREAL, &
+ 1.0_pREAL, -1.0_pREAL, &
+ -1.0_pREAL, 1.0_pREAL], shape=[2,3])
+ real(pREAL), dimension(3,4), parameter :: &
+ tetrahedron = reshape([-1.0_pREAL, -1.0_pREAL, -1.0_pREAL, &
+ 1.0_pREAL, -1.0_pREAL, -1.0_pREAL, &
+ -1.0_pREAL, 1.0_pREAL, -1.0_pREAL, &
+ -1.0_pREAL, -1.0_pREAL, 1.0_pREAL], shape=[3,4])
- type :: group_float !< variable length datatype
- real(pReal), dimension(:), allocatable :: p
- end type group_float
+ type :: group_real !< variable length datatype
+ real(pREAL), dimension(:), allocatable :: p
+ end type group_real
integer, dimension(2:3,maxOrder), public, protected :: &
FEM_nQuadrature !< number of quadrature points for spatial dimension(2-3) and interpolation order (1-maxOrder)
- type(group_float), dimension(2:3,maxOrder), public, protected :: &
+ type(group_real), dimension(2:3,maxOrder), public, protected :: &
FEM_quadrature_weights, & !< quadrature weights for each quadrature rule
FEM_quadrature_points !< quadrature point coordinates (in simplical system) for each quadrature rule
@@ -51,132 +51,132 @@ subroutine FEM_quadrature_init()
FEM_nQuadrature(2,1) = 1
allocate(FEM_quadrature_weights(2,1)%p(FEM_nQuadrature(2,1)))
- FEM_quadrature_weights(2,1)%p(1) = 1._pReal
+ FEM_quadrature_weights(2,1)%p(1) = 1._pREAL
- FEM_quadrature_points (2,1)%p = permutationStar3([1._pReal/3._pReal])
+ FEM_quadrature_points (2,1)%p = permutationStar3([1._pREAL/3._pREAL])
!--------------------------------------------------------------------------------------------------
! 2D quadratic
FEM_nQuadrature(2,2) = 3
allocate(FEM_quadrature_weights(2,2)%p(FEM_nQuadrature(2,2)))
- FEM_quadrature_weights(2,2)%p(1:3) = 1._pReal/3._pReal
+ FEM_quadrature_weights(2,2)%p(1:3) = 1._pREAL/3._pREAL
- FEM_quadrature_points (2,2)%p = permutationStar21([1._pReal/6._pReal])
+ FEM_quadrature_points (2,2)%p = permutationStar21([1._pREAL/6._pREAL])
!--------------------------------------------------------------------------------------------------
! 2D cubic
FEM_nQuadrature(2,3) = 6
allocate(FEM_quadrature_weights(2,3)%p(FEM_nQuadrature(2,3)))
- FEM_quadrature_weights(2,3)%p(1:3) = 2.2338158967801147e-1_pReal
- FEM_quadrature_weights(2,3)%p(4:6) = 1.0995174365532187e-1_pReal
+ FEM_quadrature_weights(2,3)%p(1:3) = 2.2338158967801147e-1_pREAL
+ FEM_quadrature_weights(2,3)%p(4:6) = 1.0995174365532187e-1_pREAL
FEM_quadrature_points (2,3)%p = [ &
- permutationStar21([4.4594849091596489e-1_pReal]), &
- permutationStar21([9.157621350977074e-2_pReal]) ]
+ permutationStar21([4.4594849091596489e-1_pREAL]), &
+ permutationStar21([9.157621350977074e-2_pREAL]) ]
!--------------------------------------------------------------------------------------------------
! 2D quartic
FEM_nQuadrature(2,4) = 12
allocate(FEM_quadrature_weights(2,4)%p(FEM_nQuadrature(2,4)))
- FEM_quadrature_weights(2,4)%p(1:3) = 1.1678627572637937e-1_pReal
- FEM_quadrature_weights(2,4)%p(4:6) = 5.0844906370206817e-2_pReal
- FEM_quadrature_weights(2,4)%p(7:12) = 8.285107561837358e-2_pReal
+ FEM_quadrature_weights(2,4)%p(1:3) = 1.1678627572637937e-1_pREAL
+ FEM_quadrature_weights(2,4)%p(4:6) = 5.0844906370206817e-2_pREAL
+ FEM_quadrature_weights(2,4)%p(7:12) = 8.285107561837358e-2_pREAL
FEM_quadrature_points (2,4)%p = [ &
- permutationStar21([2.4928674517091042e-1_pReal]), &
- permutationStar21([6.308901449150223e-2_pReal]), &
- permutationStar111([3.1035245103378440e-1_pReal, 5.3145049844816947e-2_pReal]) ]
+ permutationStar21([2.4928674517091042e-1_pREAL]), &
+ permutationStar21([6.308901449150223e-2_pREAL]), &
+ permutationStar111([3.1035245103378440e-1_pREAL, 5.3145049844816947e-2_pREAL]) ]
!--------------------------------------------------------------------------------------------------
! 2D quintic
FEM_nQuadrature(2,5) = 16
allocate(FEM_quadrature_weights(2,5)%p(FEM_nQuadrature(2,5)))
- FEM_quadrature_weights(2,5)%p(1:1) = 1.4431560767778717e-1_pReal
- FEM_quadrature_weights(2,5)%p(2:4) = 9.509163426728463e-2_pReal
- FEM_quadrature_weights(2,5)%p(5:7) = 1.0321737053471825e-1_pReal
- FEM_quadrature_weights(2,5)%p(8:10) = 3.2458497623198080e-2_pReal
- FEM_quadrature_weights(2,5)%p(11:16) = 2.7230314174434994e-2_pReal
+ FEM_quadrature_weights(2,5)%p(1:1) = 1.4431560767778717e-1_pREAL
+ FEM_quadrature_weights(2,5)%p(2:4) = 9.509163426728463e-2_pREAL
+ FEM_quadrature_weights(2,5)%p(5:7) = 1.0321737053471825e-1_pREAL
+ FEM_quadrature_weights(2,5)%p(8:10) = 3.2458497623198080e-2_pREAL
+ FEM_quadrature_weights(2,5)%p(11:16) = 2.7230314174434994e-2_pREAL
FEM_quadrature_points (2,5)%p = [ &
- permutationStar3([1._pReal/3._pReal]), &
- permutationStar21([4.5929258829272316e-1_pReal]), &
- permutationStar21([1.705693077517602e-1_pReal]), &
- permutationStar21([5.0547228317030975e-2_pReal]), &
- permutationStar111([2.631128296346381e-1_pReal, 8.3947774099576053e-2_pReal]) ]
+ permutationStar3([1._pREAL/3._pREAL]), &
+ permutationStar21([4.5929258829272316e-1_pREAL]), &
+ permutationStar21([1.705693077517602e-1_pREAL]), &
+ permutationStar21([5.0547228317030975e-2_pREAL]), &
+ permutationStar111([2.631128296346381e-1_pREAL, 8.3947774099576053e-2_pREAL]) ]
!--------------------------------------------------------------------------------------------------
! 3D linear
FEM_nQuadrature(3,1) = 1
allocate(FEM_quadrature_weights(3,1)%p(FEM_nQuadrature(3,1)))
- FEM_quadrature_weights(3,1)%p(1) = 1.0_pReal
+ FEM_quadrature_weights(3,1)%p(1) = 1.0_pREAL
- FEM_quadrature_points (3,1)%p = permutationStar4([0.25_pReal])
+ FEM_quadrature_points (3,1)%p = permutationStar4([0.25_pREAL])
!--------------------------------------------------------------------------------------------------
! 3D quadratic
FEM_nQuadrature(3,2) = 4
allocate(FEM_quadrature_weights(3,2)%p(FEM_nQuadrature(3,2)))
- FEM_quadrature_weights(3,2)%p(1:4) = 0.25_pReal
+ FEM_quadrature_weights(3,2)%p(1:4) = 0.25_pREAL
- FEM_quadrature_points (3,2)%p = permutationStar31([1.3819660112501052e-1_pReal])
+ FEM_quadrature_points (3,2)%p = permutationStar31([1.3819660112501052e-1_pREAL])
!--------------------------------------------------------------------------------------------------
! 3D cubic
FEM_nQuadrature(3,3) = 14
allocate(FEM_quadrature_weights(3,3)%p(FEM_nQuadrature(3,3)))
- FEM_quadrature_weights(3,3)%p(1:4) = 7.3493043116361949e-2_pReal
- FEM_quadrature_weights(3,3)%p(5:8) = 1.1268792571801585e-1_pReal
- FEM_quadrature_weights(3,3)%p(9:14) = 4.2546020777081467e-2_pReal
+ FEM_quadrature_weights(3,3)%p(1:4) = 7.3493043116361949e-2_pREAL
+ FEM_quadrature_weights(3,3)%p(5:8) = 1.1268792571801585e-1_pREAL
+ FEM_quadrature_weights(3,3)%p(9:14) = 4.2546020777081467e-2_pREAL
FEM_quadrature_points (3,3)%p = [ &
- permutationStar31([9.273525031089123e-2_pReal]), &
- permutationStar31([3.108859192633006e-1_pReal]), &
- permutationStar22([4.5503704125649649e-2_pReal]) ]
+ permutationStar31([9.273525031089123e-2_pREAL]), &
+ permutationStar31([3.108859192633006e-1_pREAL]), &
+ permutationStar22([4.5503704125649649e-2_pREAL]) ]
!--------------------------------------------------------------------------------------------------
! 3D quartic (lower precision/unknown source)
FEM_nQuadrature(3,4) = 35
allocate(FEM_quadrature_weights(3,4)%p(FEM_nQuadrature(3,4)))
- FEM_quadrature_weights(3,4)%p(1:4) = 0.0021900463965388_pReal
- FEM_quadrature_weights(3,4)%p(5:16) = 0.0143395670177665_pReal
- FEM_quadrature_weights(3,4)%p(17:22) = 0.0250305395686746_pReal
- FEM_quadrature_weights(3,4)%p(23:34) = 0.0479839333057554_pReal
- FEM_quadrature_weights(3,4)%p(35) = 0.0931745731195340_pReal
+ FEM_quadrature_weights(3,4)%p(1:4) = 0.0021900463965388_pREAL
+ FEM_quadrature_weights(3,4)%p(5:16) = 0.0143395670177665_pREAL
+ FEM_quadrature_weights(3,4)%p(17:22) = 0.0250305395686746_pREAL
+ FEM_quadrature_weights(3,4)%p(23:34) = 0.0479839333057554_pREAL
+ FEM_quadrature_weights(3,4)%p(35) = 0.0931745731195340_pREAL
FEM_quadrature_points (3,4)%p = [ &
- permutationStar31([0.0267367755543735_pReal]), &
- permutationStar211([0.0391022406356488_pReal, 0.7477598884818090_pReal]), &
- permutationStar22([0.4547545999844830_pReal]), &
- permutationStar211([0.2232010379623150_pReal, 0.0504792790607720_pReal]), &
- permutationStar4([0.25_pReal]) ]
+ permutationStar31([0.0267367755543735_pREAL]), &
+ permutationStar211([0.0391022406356488_pREAL, 0.7477598884818090_pREAL]), &
+ permutationStar22([0.4547545999844830_pREAL]), &
+ permutationStar211([0.2232010379623150_pREAL, 0.0504792790607720_pREAL]), &
+ permutationStar4([0.25_pREAL]) ]
!--------------------------------------------------------------------------------------------------
! 3D quintic (lower precision/unknown source)
FEM_nQuadrature(3,5) = 56
allocate(FEM_quadrature_weights(3,5)%p(FEM_nQuadrature(3,5)))
- FEM_quadrature_weights(3,5)%p(1:4) = 0.0010373112336140_pReal
- FEM_quadrature_weights(3,5)%p(5:16) = 0.0096016645399480_pReal
- FEM_quadrature_weights(3,5)%p(17:28) = 0.0164493976798232_pReal
- FEM_quadrature_weights(3,5)%p(29:40) = 0.0153747766513310_pReal
- FEM_quadrature_weights(3,5)%p(41:52) = 0.0293520118375230_pReal
- FEM_quadrature_weights(3,5)%p(53:56) = 0.0366291366405108_pReal
+ FEM_quadrature_weights(3,5)%p(1:4) = 0.0010373112336140_pREAL
+ FEM_quadrature_weights(3,5)%p(5:16) = 0.0096016645399480_pREAL
+ FEM_quadrature_weights(3,5)%p(17:28) = 0.0164493976798232_pREAL
+ FEM_quadrature_weights(3,5)%p(29:40) = 0.0153747766513310_pREAL
+ FEM_quadrature_weights(3,5)%p(41:52) = 0.0293520118375230_pREAL
+ FEM_quadrature_weights(3,5)%p(53:56) = 0.0366291366405108_pREAL
FEM_quadrature_points (3,5)%p = [ &
- permutationStar31([0.0149520651530592_pReal]), &
- permutationStar211([0.0340960211962615_pReal, 0.1518319491659370_pReal]), &
- permutationStar211([0.0462051504150017_pReal, 0.3549340560639790_pReal]), &
- permutationStar211([0.2281904610687610_pReal, 0.0055147549744775_pReal]), &
- permutationStar211([0.3523052600879940_pReal, 0.0992057202494530_pReal]), &
- permutationStar31([0.1344783347929940_pReal]) ]
+ permutationStar31([0.0149520651530592_pREAL]), &
+ permutationStar211([0.0340960211962615_pREAL, 0.1518319491659370_pREAL]), &
+ permutationStar211([0.0462051504150017_pREAL, 0.3549340560639790_pREAL]), &
+ permutationStar211([0.2281904610687610_pREAL, 0.0055147549744775_pREAL]), &
+ permutationStar211([0.3523052600879940_pREAL, 0.0992057202494530_pREAL]), &
+ permutationStar31([0.1344783347929940_pREAL]) ]
call selfTest()
@@ -188,8 +188,8 @@ end subroutine FEM_quadrature_init
!--------------------------------------------------------------------------------------------------
pure function permutationStar3(point) result(qPt)
- real(pReal), dimension(2) :: qPt
- real(pReal), dimension(1), intent(in) :: point
+ real(pREAL), dimension(2) :: qPt
+ real(pREAL), dimension(1), intent(in) :: point
qPt = pack(matmul(triangle,reshape([ &
@@ -203,14 +203,14 @@ end function permutationStar3
!--------------------------------------------------------------------------------------------------
pure function permutationStar21(point) result(qPt)
- real(pReal), dimension(6) :: qPt
- real(pReal), dimension(1), intent(in) :: point
+ real(pREAL), dimension(6) :: qPt
+ real(pREAL), dimension(1), intent(in) :: point
qPt = pack(matmul(triangle,reshape([ &
- point(1), point(1), 1.0_pReal - 2.0_pReal*point(1), &
- point(1), 1.0_pReal - 2.0_pReal*point(1), point(1), &
- 1.0_pReal - 2.0_pReal*point(1), point(1), point(1)],[3,3])),.true.)
+ point(1), point(1), 1.0_pREAL - 2.0_pREAL*point(1), &
+ point(1), 1.0_pREAL - 2.0_pREAL*point(1), point(1), &
+ 1.0_pREAL - 2.0_pREAL*point(1), point(1), point(1)],[3,3])),.true.)
end function permutationStar21
@@ -220,17 +220,17 @@ end function permutationStar21
!--------------------------------------------------------------------------------------------------
pure function permutationStar111(point) result(qPt)
- real(pReal), dimension(12) :: qPt
- real(pReal), dimension(2), intent(in) :: point
+ real(pREAL), dimension(12) :: qPt
+ real(pREAL), dimension(2), intent(in) :: point
qPt = pack(matmul(triangle,reshape([ &
- point(1), point(2), 1.0_pReal - point(1) - point(2), &
- point(1), 1.0_pReal - point(1) - point(2), point(2), &
- point(2), point(1), 1.0_pReal - point(1) - point(2), &
- point(2), 1.0_pReal - point(1) - point(2), point(1), &
- 1.0_pReal - point(1) - point(2), point(2), point(1), &
- 1.0_pReal - point(1) - point(2), point(1), point(2)],[3,6])),.true.)
+ point(1), point(2), 1.0_pREAL - point(1) - point(2), &
+ point(1), 1.0_pREAL - point(1) - point(2), point(2), &
+ point(2), point(1), 1.0_pREAL - point(1) - point(2), &
+ point(2), 1.0_pREAL - point(1) - point(2), point(1), &
+ 1.0_pREAL - point(1) - point(2), point(2), point(1), &
+ 1.0_pREAL - point(1) - point(2), point(1), point(2)],[3,6])),.true.)
end function permutationStar111
@@ -240,8 +240,8 @@ end function permutationStar111
!--------------------------------------------------------------------------------------------------
pure function permutationStar4(point) result(qPt)
- real(pReal), dimension(3) :: qPt
- real(pReal), dimension(1), intent(in) :: point
+ real(pREAL), dimension(3) :: qPt
+ real(pREAL), dimension(1), intent(in) :: point
qPt = pack(matmul(tetrahedron,reshape([ &
@@ -255,15 +255,15 @@ end function permutationStar4
!--------------------------------------------------------------------------------------------------
pure function permutationStar31(point) result(qPt)
- real(pReal), dimension(12) :: qPt
- real(pReal), dimension(1), intent(in) :: point
+ real(pREAL), dimension(12) :: qPt
+ real(pREAL), dimension(1), intent(in) :: point
qPt = pack(matmul(tetrahedron,reshape([ &
- point(1), point(1), point(1), 1.0_pReal - 3.0_pReal*point(1), &
- point(1), point(1), 1.0_pReal - 3.0_pReal*point(1), point(1), &
- point(1), 1.0_pReal - 3.0_pReal*point(1), point(1), point(1), &
- 1.0_pReal - 3.0_pReal*point(1), point(1), point(1), point(1)],[4,4])),.true.)
+ point(1), point(1), point(1), 1.0_pREAL - 3.0_pREAL*point(1), &
+ point(1), point(1), 1.0_pREAL - 3.0_pREAL*point(1), point(1), &
+ point(1), 1.0_pREAL - 3.0_pREAL*point(1), point(1), point(1), &
+ 1.0_pREAL - 3.0_pREAL*point(1), point(1), point(1), point(1)],[4,4])),.true.)
end function permutationStar31
@@ -273,17 +273,17 @@ end function permutationStar31
!--------------------------------------------------------------------------------------------------
function permutationStar22(point) result(qPt)
- real(pReal), dimension(18) :: qPt
- real(pReal), dimension(1), intent(in) :: point
+ real(pREAL), dimension(18) :: qPt
+ real(pREAL), dimension(1), intent(in) :: point
qPt = pack(matmul(tetrahedron,reshape([ &
- point(1), point(1), 0.5_pReal - point(1), 0.5_pReal - point(1), &
- point(1), 0.5_pReal - point(1), point(1), 0.5_pReal - point(1), &
- 0.5_pReal - point(1), point(1), point(1), 0.5_pReal - point(1), &
- 0.5_pReal - point(1), point(1), 0.5_pReal - point(1), point(1), &
- 0.5_pReal - point(1), 0.5_pReal - point(1), point(1), point(1), &
- point(1), 0.5_pReal - point(1), 0.5_pReal - point(1), point(1)],[4,6])),.true.)
+ point(1), point(1), 0.5_pREAL - point(1), 0.5_pREAL - point(1), &
+ point(1), 0.5_pREAL - point(1), point(1), 0.5_pREAL - point(1), &
+ 0.5_pREAL - point(1), point(1), point(1), 0.5_pREAL - point(1), &
+ 0.5_pREAL - point(1), point(1), 0.5_pREAL - point(1), point(1), &
+ 0.5_pREAL - point(1), 0.5_pREAL - point(1), point(1), point(1), &
+ point(1), 0.5_pREAL - point(1), 0.5_pREAL - point(1), point(1)],[4,6])),.true.)
end function permutationStar22
@@ -293,23 +293,23 @@ end function permutationStar22
!--------------------------------------------------------------------------------------------------
pure function permutationStar211(point) result(qPt)
- real(pReal), dimension(36) :: qPt
- real(pReal), dimension(2), intent(in) :: point
+ real(pREAL), dimension(36) :: qPt
+ real(pREAL), dimension(2), intent(in) :: point
qPt = pack(matmul(tetrahedron,reshape([ &
- point(1), point(1), point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2), &
- point(1), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(2), &
- point(1), point(2), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), &
- point(1), point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), &
- point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(2), &
- point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(2), point(1), &
- point(2), point(1), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), &
- point(2), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), &
- point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(1), &
- 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(1), point(2), &
- 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(2), point(1), &
- 1.0_pReal - 2.0_pReal*point(1) - point(2), point(2), point(1), point(1)],[4,12])),.true.)
+ point(1), point(1), point(2), 1.0_pREAL - 2.0_pREAL*point(1) - point(2), &
+ point(1), point(1), 1.0_pREAL - 2.0_pREAL*point(1) - point(2), point(2), &
+ point(1), point(2), point(1), 1.0_pREAL - 2.0_pREAL*point(1) - point(2), &
+ point(1), point(2), 1.0_pREAL - 2.0_pREAL*point(1) - point(2), point(1), &
+ point(1), 1.0_pREAL - 2.0_pREAL*point(1) - point(2), point(1), point(2), &
+ point(1), 1.0_pREAL - 2.0_pREAL*point(1) - point(2), point(2), point(1), &
+ point(2), point(1), point(1), 1.0_pREAL - 2.0_pREAL*point(1) - point(2), &
+ point(2), point(1), 1.0_pREAL - 2.0_pREAL*point(1) - point(2), point(1), &
+ point(2), 1.0_pREAL - 2.0_pREAL*point(1) - point(2), point(1), point(1), &
+ 1.0_pREAL - 2.0_pREAL*point(1) - point(2), point(1), point(1), point(2), &
+ 1.0_pREAL - 2.0_pREAL*point(1) - point(2), point(1), point(2), point(1), &
+ 1.0_pREAL - 2.0_pREAL*point(1) - point(2), point(2), point(1), point(1)],[4,12])),.true.)
end function permutationStar211
@@ -319,35 +319,35 @@ end function permutationStar211
!--------------------------------------------------------------------------------------------------
pure function permutationStar1111(point) result(qPt)
- real(pReal), dimension(72) :: qPt
- real(pReal), dimension(3), intent(in) :: point
+ real(pREAL), dimension(72) :: qPt
+ real(pREAL), dimension(3), intent(in) :: point
qPt = pack(matmul(tetrahedron,reshape([ &
- point(1), point(2), point(3), 1.0_pReal - point(1) - point(2)- point(3), &
- point(1), point(2), 1.0_pReal - point(1) - point(2)- point(3), point(3), &
- point(1), point(3), point(2), 1.0_pReal - point(1) - point(2)- point(3), &
- point(1), point(3), 1.0_pReal - point(1) - point(2)- point(3), point(2), &
- point(1), 1.0_pReal - point(1) - point(2)- point(3), point(2), point(3), &
- point(1), 1.0_pReal - point(1) - point(2)- point(3), point(3), point(2), &
- point(2), point(1), point(3), 1.0_pReal - point(1) - point(2)- point(3), &
- point(2), point(1), 1.0_pReal - point(1) - point(2)- point(3), point(3), &
- point(2), point(3), point(1), 1.0_pReal - point(1) - point(2)- point(3), &
- point(2), point(3), 1.0_pReal - point(1) - point(2)- point(3), point(1), &
- point(2), 1.0_pReal - point(1) - point(2)- point(3), point(1), point(3), &
- point(2), 1.0_pReal - point(1) - point(2)- point(3), point(3), point(1), &
- point(3), point(1), point(2), 1.0_pReal - point(1) - point(2)- point(3), &
- point(3), point(1), 1.0_pReal - point(1) - point(2)- point(3), point(2), &
- point(3), point(2), point(1), 1.0_pReal - point(1) - point(2)- point(3), &
- point(3), point(2), 1.0_pReal - point(1) - point(2)- point(3), point(1), &
- point(3), 1.0_pReal - point(1) - point(2)- point(3), point(1), point(2), &
- point(3), 1.0_pReal - point(1) - point(2)- point(3), point(2), point(1), &
- 1.0_pReal - point(1) - point(2)- point(3), point(1), point(2), point(3), &
- 1.0_pReal - point(1) - point(2)- point(3), point(1), point(3), point(2), &
- 1.0_pReal - point(1) - point(2)- point(3), point(2), point(1), point(3), &
- 1.0_pReal - point(1) - point(2)- point(3), point(2), point(3), point(1), &
- 1.0_pReal - point(1) - point(2)- point(3), point(3), point(1), point(2), &
- 1.0_pReal - point(1) - point(2)- point(3), point(3), point(2), point(1)],[4,24])),.true.)
+ point(1), point(2), point(3), 1.0_pREAL - point(1) - point(2)- point(3), &
+ point(1), point(2), 1.0_pREAL - point(1) - point(2)- point(3), point(3), &
+ point(1), point(3), point(2), 1.0_pREAL - point(1) - point(2)- point(3), &
+ point(1), point(3), 1.0_pREAL - point(1) - point(2)- point(3), point(2), &
+ point(1), 1.0_pREAL - point(1) - point(2)- point(3), point(2), point(3), &
+ point(1), 1.0_pREAL - point(1) - point(2)- point(3), point(3), point(2), &
+ point(2), point(1), point(3), 1.0_pREAL - point(1) - point(2)- point(3), &
+ point(2), point(1), 1.0_pREAL - point(1) - point(2)- point(3), point(3), &
+ point(2), point(3), point(1), 1.0_pREAL - point(1) - point(2)- point(3), &
+ point(2), point(3), 1.0_pREAL - point(1) - point(2)- point(3), point(1), &
+ point(2), 1.0_pREAL - point(1) - point(2)- point(3), point(1), point(3), &
+ point(2), 1.0_pREAL - point(1) - point(2)- point(3), point(3), point(1), &
+ point(3), point(1), point(2), 1.0_pREAL - point(1) - point(2)- point(3), &
+ point(3), point(1), 1.0_pREAL - point(1) - point(2)- point(3), point(2), &
+ point(3), point(2), point(1), 1.0_pREAL - point(1) - point(2)- point(3), &
+ point(3), point(2), 1.0_pREAL - point(1) - point(2)- point(3), point(1), &
+ point(3), 1.0_pREAL - point(1) - point(2)- point(3), point(1), point(2), &
+ point(3), 1.0_pREAL - point(1) - point(2)- point(3), point(2), point(1), &
+ 1.0_pREAL - point(1) - point(2)- point(3), point(1), point(2), point(3), &
+ 1.0_pREAL - point(1) - point(2)- point(3), point(1), point(3), point(2), &
+ 1.0_pREAL - point(1) - point(2)- point(3), point(2), point(1), point(3), &
+ 1.0_pREAL - point(1) - point(2)- point(3), point(2), point(3), point(1), &
+ 1.0_pREAL - point(1) - point(2)- point(3), point(3), point(1), point(2), &
+ 1.0_pREAL - point(1) - point(2)- point(3), point(3), point(2), point(1)],[4,24])),.true.)
end function permutationStar1111
@@ -358,12 +358,12 @@ end function permutationStar1111
subroutine selfTest
integer :: o, d, n
- real(pReal), dimension(2:3), parameter :: w = [3.0_pReal,2.0_pReal]
+ real(pREAL), dimension(2:3), parameter :: w = [3.0_pREAL,2.0_pREAL]
do d = lbound(FEM_quadrature_weights,1), ubound(FEM_quadrature_weights,1)
do o = lbound(FEM_quadrature_weights(d,:),1), ubound(FEM_quadrature_weights(d,:),1)
- if (dNeq(sum(FEM_quadrature_weights(d,o)%p),1.0_pReal,5e-15_pReal)) &
+ if (dNeq(sum(FEM_quadrature_weights(d,o)%p),1.0_pREAL,5e-15_pREAL)) &
error stop 'quadrature weights'
end do
end do
@@ -371,7 +371,7 @@ subroutine selfTest
do d = lbound(FEM_quadrature_points,1), ubound(FEM_quadrature_points,1)
do o = lbound(FEM_quadrature_points(d,:),1), ubound(FEM_quadrature_points(d,:),1)
n = size(FEM_quadrature_points(d,o)%p,1)/d
- if (any(dNeq(sum(reshape(FEM_quadrature_points(d,o)%p,[d,n]),2),-real(n,pReal)/w(d),1.e-14_pReal))) &
+ if (any(dNeq(sum(reshape(FEM_quadrature_points(d,o)%p,[d,n]),2),-real(n,pREAL)/w(d),1.e-14_pREAL))) &
error stop 'quadrature points'
end do
end do
diff --git a/src/mesh/FEM_utilities.f90 b/src/mesh/FEM_utilities.f90
index 6fc3b4f61..d30b223f0 100644
--- a/src/mesh/FEM_utilities.f90
+++ b/src/mesh/FEM_utilities.f90
@@ -29,7 +29,7 @@ module FEM_utilities
private
logical, public :: cutBack = .false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill
- real(pReal), public, protected :: wgt !< weighting factor 1/Nelems
+ real(pREAL), public, protected :: wgt !< weighting factor 1/Nelems
!--------------------------------------------------------------------------------------------------
@@ -59,7 +59,7 @@ module FEM_utilities
type, public :: tComponentBC
integer(kind(COMPONENT_UNDEFINED_ID)) :: ID
- real(pReal), allocatable, dimension(:) :: Value
+ real(pREAL), allocatable, dimension(:) :: Value
logical, allocatable, dimension(:) :: Mask
end type tComponentBC
@@ -92,7 +92,7 @@ contains
!--------------------------------------------------------------------------------------------------
subroutine FEM_utilities_init
- character(len=pStringLen) :: petsc_optionsOrder
+ character(len=pSTRLEN) :: petsc_optionsOrder
type(tDict), pointer :: &
num_mesh
integer :: &
@@ -122,13 +122,13 @@ subroutine FEM_utilities_init
&-mechanical_snes_ksp_ew_rtol0 0.01 -mechanical_snes_ksp_ew_rtolmax 0.01 &
&-mechanical_ksp_type fgmres -mechanical_ksp_max_it 25', err_PETSc)
CHKERRQ(err_PETSc)
- call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_mesh%get_asString('PETSc_options',defaultVal=''),err_PETSc)
+ call PetscOptionsInsertString(PETSC_NULL_OPTIONS,num_mesh%get_asStr('PETSc_options',defaultVal=''),err_PETSc)
CHKERRQ(err_PETSc)
write(petsc_optionsOrder,'(a,i0)') '-mechFE_petscspace_degree ', p_s
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_optionsOrder),err_PETSc)
CHKERRQ(err_PETSc)
- wgt = real(mesh_maxNips*mesh_NcpElemsGlobal,pReal)**(-1)
+ wgt = real(mesh_maxNips*mesh_NcpElemsGlobal,pREAL)**(-1)
end subroutine FEM_utilities_init
@@ -139,9 +139,9 @@ end subroutine FEM_utilities_init
!--------------------------------------------------------------------------------------------------
subroutine utilities_constitutiveResponse(timeinc,P_av,forwardData)
- real(pReal), intent(in) :: timeinc !< loading time
+ real(pREAL), intent(in) :: timeinc !< loading time
logical, intent(in) :: forwardData !< age results
- real(pReal),intent(out), dimension(3,3) :: P_av !< average PK stress
+ real(pREAL),intent(out), dimension(3,3) :: P_av !< average PK stress
integer(MPI_INTEGER_KIND) :: err_MPI
@@ -170,8 +170,8 @@ subroutine utilities_projectBCValues(localVec,section,field,comp,bcPointsIS,BCVa
PetscSection :: section
IS :: bcPointsIS
PetscInt, pointer :: bcPoints(:)
- real(pReal), pointer :: localArray(:)
- real(pReal) :: BCValue,BCDotValue,timeinc
+ real(pREAL), pointer :: localArray(:)
+ real(pREAL) :: BCValue,BCDotValue,timeinc
PetscErrorCode :: err_PETSc
diff --git a/src/mesh/discretization_mesh.f90 b/src/mesh/discretization_mesh.f90
index b8505f3cb..5cd12549e 100644
--- a/src/mesh/discretization_mesh.f90
+++ b/src/mesh/discretization_mesh.f90
@@ -49,11 +49,11 @@ module discretization_mesh
PetscInt, dimension(:), allocatable, public, protected :: &
mesh_boundaries
- real(pReal), dimension(:,:), allocatable :: &
+ real(pREAL), dimension(:,:), allocatable :: &
mesh_ipVolume, & !< volume associated with IP (initially!)
mesh_node0 !< node x,y,z coordinates (initially!)
- real(pReal), dimension(:,:,:), allocatable :: &
+ real(pREAL), dimension(:,:,:), allocatable :: &
mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!)
#ifdef PETSC_USE_64BIT_INDICES
@@ -92,7 +92,7 @@ subroutine discretization_mesh_init(restart)
num_mesh
integer :: p_i, dim !< integration order (quadrature rule)
type(tvec) :: coords_node0
- real(pReal), pointer, dimension(:) :: &
+ real(pREAL), pointer, dimension(:) :: &
mesh_node0_temp
print'(/,1x,a)', '<<<+- discretization_mesh init -+>>>'
@@ -176,7 +176,7 @@ subroutine discretization_mesh_init(restart)
end do
materialAt = materialAt + 1_pPETSCINT
- allocate(mesh_node0(3,mesh_Nnodes),source=0.0_pReal)
+ allocate(mesh_node0(3,mesh_Nnodes),source=0.0_pREAL)
mesh_node0(1:dimPlex,:) = reshape(mesh_node0_temp,[dimPlex,mesh_Nnodes])
@@ -200,7 +200,7 @@ subroutine mesh_FEM_build_ipVolumes(dimPlex)
PetscInt :: cellStart, cellEnd, cell
PetscErrorCode :: err_PETSc
- allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems),source=0.0_pReal)
+ allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems),source=0.0_pREAL)
call DMPlexGetHeightStratum(geomMesh,0_pPETSCINT,cellStart,cellEnd,err_PETSc)
CHKERRQ(err_PETSc)
@@ -209,7 +209,7 @@ subroutine mesh_FEM_build_ipVolumes(dimPlex)
do cell = cellStart, cellEnd-1
call DMPlexComputeCellGeometryFVM(geomMesh,cell,vol,pCent,pNorm,err_PETSc)
CHKERRQ(err_PETSc)
- mesh_ipVolume(:,cell+1) = vol/real(mesh_maxNips,pReal)
+ mesh_ipVolume(:,cell+1) = vol/real(mesh_maxNips,pREAL)
end do
end subroutine mesh_FEM_build_ipVolumes
@@ -229,7 +229,7 @@ subroutine mesh_FEM_build_ipCoordinates(dimPlex,qPoints)
PetscErrorCode :: err_PETSc
- allocate(mesh_ipCoordinates(3,mesh_maxNips,mesh_NcpElems),source=0.0_pReal)
+ allocate(mesh_ipCoordinates(3,mesh_maxNips,mesh_NcpElems),source=0.0_pREAL)
allocate(pV0(dimPlex))
allocatE(pCellJ(dimPlex**2))
@@ -245,7 +245,7 @@ subroutine mesh_FEM_build_ipCoordinates(dimPlex,qPoints)
mesh_ipCoordinates(dirI,qPt,cell+1) = pV0(dirI)
do dirJ = 1_pPETSCINT, dimPlex
mesh_ipCoordinates(dirI,qPt,cell+1) = mesh_ipCoordinates(dirI,qPt,cell+1) + &
- pCellJ((dirI-1)*dimPlex+dirJ)*(qPoints(qOffset+dirJ) + 1.0_pReal)
+ pCellJ((dirI-1)*dimPlex+dirJ)*(qPoints(qOffset+dirJ) + 1.0_pREAL)
end do
end do
qOffset = qOffset + dimPlex
@@ -259,7 +259,7 @@ end subroutine mesh_FEM_build_ipCoordinates
!--------------------------------------------------------------------------------------------------
subroutine writeGeometry(coordinates_points,coordinates_nodes)
- real(pReal), dimension(:,:), intent(in) :: &
+ real(pREAL), dimension(:,:), intent(in) :: &
coordinates_nodes, &
coordinates_points
diff --git a/src/mesh/mesh_mech_FEM.f90 b/src/mesh/mesh_mech_FEM.f90
index f612968fe..a12738fd4 100644
--- a/src/mesh/mesh_mech_FEM.f90
+++ b/src/mesh/mesh_mech_FEM.f90
@@ -37,7 +37,7 @@ module mesh_mechanical_FEM
! derived types
type tSolutionParams
type(tFieldBC) :: fieldBC
- real(pReal) :: timeinc
+ real(pREAL) :: timeinc
end type tSolutionParams
type(tSolutionParams) :: params
@@ -48,7 +48,7 @@ module mesh_mechanical_FEM
itmax
logical :: &
BBarStabilisation
- real(pReal) :: &
+ real(pREAL) :: &
eps_struct_atol, & !< absolute tolerance for mechanical equilibrium
eps_struct_rtol !< relative tolerance for mechanical equilibrium
end type tNumerics
@@ -65,11 +65,11 @@ module mesh_mechanical_FEM
!--------------------------------------------------------------------------------------------------
! stress, stiffness and compliance average etc.
- character(len=pStringLen) :: incInfo
- real(pReal), dimension(3,3) :: &
- P_av = 0.0_pReal
+ character(len=pSTRLEN) :: incInfo
+ real(pREAL), dimension(3,3) :: &
+ P_av = 0.0_pREAL
logical :: ForwardData
- real(pReal), parameter :: eps = 1.0e-18_pReal
+ real(pREAL), parameter :: eps = 1.0e-18_pREAL
external :: & ! ToDo: write interfaces
#ifdef PETSC_USE_64BIT_INDICES
@@ -120,12 +120,12 @@ subroutine FEM_mechanical_init(fieldBC)
PetscReal :: detJ
PetscReal, allocatable, target :: cellJMat(:,:)
- real(pReal), pointer, dimension(:) :: px_scal
- real(pReal), allocatable, target, dimension(:) :: x_scal
+ real(pREAL), pointer, dimension(:) :: px_scal
+ real(pREAL), allocatable, target, dimension(:) :: x_scal
character(len=*), parameter :: prefix = 'mechFE_'
PetscErrorCode :: err_PETSc
- real(pReal), dimension(3,3) :: devNull
+ real(pREAL), dimension(3,3) :: devNull
type(tDict), pointer :: &
num_mesh
@@ -137,12 +137,12 @@ subroutine FEM_mechanical_init(fieldBC)
num%p_i = int(num_mesh%get_asInt('p_i',defaultVal = 2),pPETSCINT)
num%itmax = int(num_mesh%get_asInt('itmax',defaultVal=250),pPETSCINT)
num%BBarStabilisation = num_mesh%get_asBool('bbarstabilisation',defaultVal = .false.)
- num%eps_struct_atol = num_mesh%get_asFloat('eps_struct_atol', defaultVal = 1.0e-10_pReal)
- num%eps_struct_rtol = num_mesh%get_asFloat('eps_struct_rtol', defaultVal = 1.0e-4_pReal)
+ num%eps_struct_atol = num_mesh%get_asReal('eps_struct_atol', defaultVal = 1.0e-10_pREAL)
+ num%eps_struct_rtol = num_mesh%get_asReal('eps_struct_rtol', defaultVal = 1.0e-4_pREAL)
if (num%itmax <= 1) call IO_error(301,ext_msg='itmax')
- if (num%eps_struct_rtol <= 0.0_pReal) call IO_error(301,ext_msg='eps_struct_rtol')
- if (num%eps_struct_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_struct_atol')
+ if (num%eps_struct_rtol <= 0.0_pREAL) call IO_error(301,ext_msg='eps_struct_rtol')
+ if (num%eps_struct_atol <= 0.0_pREAL) call IO_error(301,ext_msg='eps_struct_atol')
!--------------------------------------------------------------------------------------------------
! Setup FEM mech mesh
@@ -264,16 +264,16 @@ subroutine FEM_mechanical_init(fieldBC)
CHKERRQ(err_PETSc)
call SNESSetConvergenceTest(mechanical_snes,FEM_mechanical_converged,PETSC_NULL_VEC,PETSC_NULL_FUNCTION,err_PETSc)
CHKERRQ(err_PETSc)
- call SNESSetTolerances(mechanical_snes,1.0_pReal,0.0_pReal,0.0_pReal,num%itmax,num%itmax,err_PETSc)
+ call SNESSetTolerances(mechanical_snes,1.0_pREAL,0.0_pREAL,0.0_pREAL,num%itmax,num%itmax,err_PETSc)
CHKERRQ(err_PETSc)
call SNESSetFromOptions(mechanical_snes,err_PETSc)
CHKERRQ(err_PETSc)
!--------------------------------------------------------------------------------------------------
! init fields
- call VecSet(solution ,0.0_pReal,err_PETSc)
+ call VecSet(solution ,0.0_pREAL,err_PETSc)
CHKERRQ(err_PETSc)
- call VecSet(solution_rate,0.0_pReal,err_PETSc)
+ call VecSet(solution_rate,0.0_pREAL,err_PETSc)
CHKERRQ(err_PETSc)
allocate(x_scal(cellDof))
allocate(nodalWeightsP(1))
@@ -289,7 +289,7 @@ subroutine FEM_mechanical_init(fieldBC)
call DMPlexGetHeightStratum(mechanical_mesh,0_pPETSCINT,cellStart,cellEnd,err_PETSc)
CHKERRQ(err_PETSc)
do cell = cellStart, cellEnd-1 !< loop over all elements
- x_scal = 0.0_pReal
+ x_scal = 0.0_pREAL
call DMPlexComputeCellGeometryAffineFEM(mechanical_mesh,cell,pV0,pCellJ,pInvcellJ,detJ,err_PETSc)
CHKERRQ(err_PETSc)
cellJMat = reshape(pCellJ,shape=[dimPlex,dimPlex])
@@ -298,13 +298,13 @@ subroutine FEM_mechanical_init(fieldBC)
CHKERRQ(err_PETSc)
call PetscQuadratureGetData(functional,dimPlex,nc,nNodalPoints,nodalPointsP,nodalWeightsP,err_PETSc)
CHKERRQ(err_PETSc)
- x_scal(basis+1:basis+dimPlex) = pV0 + matmul(transpose(cellJMat),nodalPointsP + 1.0_pReal)
+ x_scal(basis+1:basis+dimPlex) = pV0 + matmul(transpose(cellJMat),nodalPointsP + 1.0_pREAL)
end do
px_scal => x_scal
call DMPlexVecSetClosure(mechanical_mesh,section,solution_local,cell,px_scal,5,err_PETSc)
CHKERRQ(err_PETSc)
end do
- call utilities_constitutiveResponse(0.0_pReal,devNull,.true.)
+ call utilities_constitutiveResponse(0.0_pREAL,devNull,.true.)
end subroutine FEM_mechanical_init
@@ -317,7 +317,7 @@ type(tSolutionState) function FEM_mechanical_solution( &
!--------------------------------------------------------------------------------------------------
! input data for solution
- real(pReal), intent(in) :: &
+ real(pREAL), intent(in) :: &
timeinc, & !< increment in time for current solution
timeinc_old !< increment in time of last increment
type(tFieldBC), intent(in) :: &
@@ -369,8 +369,8 @@ subroutine FEM_mechanical_formResidual(dm_local,xx_local,f_local,dummy,err_PETSc
PetscDS :: prob
Vec :: x_local, f_local, xx_local
PetscSection :: section
- real(pReal), dimension(:), pointer :: x_scal, pf_scal
- real(pReal), dimension(cellDof), target :: f_scal
+ real(pREAL), dimension(:), pointer :: x_scal, pf_scal
+ real(pREAL), dimension(cellDof), target :: f_scal
PetscReal :: IcellJMat(dimPlex,dimPlex)
PetscReal, dimension(:),pointer :: pV0, pCellJ, pInvcellJ, basisField, basisFieldDer
PetscInt :: cellStart, cellEnd, cell, field, face, &
@@ -397,7 +397,7 @@ subroutine FEM_mechanical_formResidual(dm_local,xx_local,f_local,dummy,err_PETSc
CHKERRQ(err_PETSc)
call DMGetLocalVector(dm_local,x_local,err_PETSc)
CHKERRQ(err_PETSc)
- call VecWAXPY(x_local,1.0_pReal,xx_local,solution_local,err_PETSc)
+ call VecWAXPY(x_local,1.0_pREAL,xx_local,solution_local,err_PETSc)
CHKERRQ(err_PETSc)
do field = 1_pPETSCINT, dimPlex; do face = 1_pPETSCINT, mesh_Nboundaries
if (params%fieldBC%componentBC(field)%Mask(face)) then
@@ -406,7 +406,7 @@ subroutine FEM_mechanical_formResidual(dm_local,xx_local,f_local,dummy,err_PETSc
call DMGetStratumIS(dm_local,'Face Sets',mesh_boundaries(face),bcPoints,err_PETSc)
CHKERRQ(err_PETSc)
call utilities_projectBCValues(x_local,section,0_pPETSCINT,field-1,bcPoints, &
- 0.0_pReal,params%fieldBC%componentBC(field)%Value(face),params%timeinc)
+ 0.0_pREAL,params%fieldBC%componentBC(field)%Value(face),params%timeinc)
call ISDestroy(bcPoints,err_PETSc)
CHKERRQ(err_PETSc)
end if
@@ -426,7 +426,7 @@ subroutine FEM_mechanical_formResidual(dm_local,xx_local,f_local,dummy,err_PETSc
IcellJMat = reshape(pInvcellJ,shape=[dimPlex,dimPlex])
do qPt = 0_pPETSCINT, nQuadrature-1_pPETSCINT
m = cell*nQuadrature + qPt+1_pPETSCINT
- BMat = 0.0_pReal
+ BMat = 0.0_pREAL
do basis = 0_pPETSCINT, nBasis-1_pPETSCINT
do comp = 0_pPETSCINT, dimPlex-1_pPETSCINT
cidx = basis*dimPlex+comp
@@ -438,11 +438,11 @@ subroutine FEM_mechanical_formResidual(dm_local,xx_local,f_local,dummy,err_PETSc
homogenization_F(1:dimPlex,1:dimPlex,m) = reshape(matmul(BMat,x_scal),shape=[dimPlex,dimPlex], order=[2,1])
end do
if (num%BBarStabilisation) then
- detFAvg = math_det33(sum(homogenization_F(1:3,1:3,cell*nQuadrature+1:(cell+1)*nQuadrature),dim=3)/real(nQuadrature,pReal))
+ detFAvg = math_det33(sum(homogenization_F(1:3,1:3,cell*nQuadrature+1:(cell+1)*nQuadrature),dim=3)/real(nQuadrature,pREAL))
do qPt = 0, nQuadrature-1
m = cell*nQuadrature + qPt+1
homogenization_F(1:dimPlex,1:dimPlex,m) = homogenization_F(1:dimPlex,1:dimPlex,m) &
- * (detFAvg/math_det33(homogenization_F(1:3,1:3,m)))**(1.0_pReal/real(dimPlex,pReal))
+ * (detFAvg/math_det33(homogenization_F(1:3,1:3,m)))**(1.0_pREAL/real(dimPlex,pREAL))
end do
end if
@@ -465,10 +465,10 @@ subroutine FEM_mechanical_formResidual(dm_local,xx_local,f_local,dummy,err_PETSc
call DMPlexComputeCellGeometryAffineFEM(dm_local,cell,pV0,pCellJ,pInvcellJ,detJ,err_PETSc)
CHKERRQ(err_PETSc)
IcellJMat = reshape(pInvcellJ,shape=[dimPlex,dimPlex])
- f_scal = 0.0_pReal
+ f_scal = 0.0_pREAL
do qPt = 0_pPETSCINT, nQuadrature-1_pPETSCINT
m = cell*nQuadrature + qPt+1_pPETSCINT
- BMat = 0.0_pReal
+ BMat = 0.0_pREAL
do basis = 0_pPETSCINT, nBasis-1_pPETSCINT
do comp = 0_pPETSCINT, dimPlex-1_pPETSCINT
cidx = basis*dimPlex+comp
@@ -517,10 +517,10 @@ subroutine FEM_mechanical_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,err_P
PetscReal, dimension(:), pointer :: basisField, basisFieldDer, &
pV0, pCellJ, pInvcellJ
- real(pReal), dimension(:), pointer :: pK_e, x_scal
+ real(pREAL), dimension(:), pointer :: pK_e, x_scal
- real(pReal),dimension(cellDOF,cellDOF), target :: K_e
- real(pReal),dimension(cellDOF,cellDOF) :: K_eA, K_eB
+ real(pREAL),dimension(cellDOF,cellDOF), target :: K_e
+ real(pREAL),dimension(cellDOF,cellDOF) :: K_eA, K_eB
PetscInt :: cellStart, cellEnd, cell, field, face, &
qPt, basis, comp, cidx,bcSize, m, i
@@ -547,7 +547,7 @@ subroutine FEM_mechanical_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,err_P
call DMGetLocalVector(dm_local,x_local,err_PETSc)
CHKERRQ(err_PETSc)
- call VecWAXPY(x_local,1.0_pReal,xx_local,solution_local,err_PETSc)
+ call VecWAXPY(x_local,1.0_pREAL,xx_local,solution_local,err_PETSc)
CHKERRQ(err_PETSc)
do field = 1, dimPlex; do face = 1, mesh_Nboundaries
if (params%fieldBC%componentBC(field)%Mask(face)) then
@@ -556,7 +556,7 @@ subroutine FEM_mechanical_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,err_P
call DMGetStratumIS(dm_local,'Face Sets',mesh_boundaries(face),bcPoints,err_PETSc)
CHKERRQ(err_PETSc)
call utilities_projectBCValues(x_local,section,0_pPETSCINT,field-1,bcPoints, &
- 0.0_pReal,params%fieldBC%componentBC(field)%Value(face),params%timeinc)
+ 0.0_pREAL,params%fieldBC%componentBC(field)%Value(face),params%timeinc)
call ISDestroy(bcPoints,err_PETSc)
CHKERRQ(err_PETSc)
end if
@@ -569,14 +569,14 @@ subroutine FEM_mechanical_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,err_P
CHKERRQ(err_PETSc)
call DMPlexComputeCellGeometryAffineFEM(dm_local,cell,pV0,pCellJ,pInvcellJ,detJ,err_PETSc)
CHKERRQ(err_PETSc)
- K_eA = 0.0_pReal
- K_eB = 0.0_pReal
- MatB = 0.0_pReal
- FAvg = 0.0_pReal
- BMatAvg = 0.0_pReal
+ K_eA = 0.0_pREAL
+ K_eB = 0.0_pREAL
+ MatB = 0.0_pREAL
+ FAvg = 0.0_pREAL
+ BMatAvg = 0.0_pREAL
do qPt = 0_pPETSCINT, nQuadrature-1_pPETSCINT
m = cell*nQuadrature + qPt + 1_pPETSCINT
- BMat = 0.0_pReal
+ BMat = 0.0_pREAL
do basis = 0_pPETSCINT, nBasis-1_pPETSCINT
do comp = 0_pPETSCINT, dimPlex-1_pPETSCINT
cidx = basis*dimPlex+comp
@@ -591,7 +591,7 @@ subroutine FEM_mechanical_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,err_P
if (num%BBarStabilisation) then
F(1:dimPlex,1:dimPlex) = reshape(matmul(BMat,x_scal),shape=[dimPlex,dimPlex])
FInv = math_inv33(F)
- K_eA = K_eA + matmul(transpose(BMat),MatA)*math_det33(FInv)**(1.0_pReal/real(dimPlex,pReal))
+ K_eA = K_eA + matmul(transpose(BMat),MatA)*math_det33(FInv)**(1.0_pREAL/real(dimPlex,pREAL))
K_eB = K_eB - &
matmul(transpose(matmul(reshape(homogenization_F(1:dimPlex,1:dimPlex,m),shape=[dimPlex**2,1_pPETSCINT]), &
matmul(reshape(FInv(1:dimPlex,1:dimPlex), &
@@ -606,10 +606,10 @@ subroutine FEM_mechanical_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,err_P
end do
if (num%BBarStabilisation) then
FInv = math_inv33(FAvg)
- K_e = K_eA*math_det33(FAvg/real(nQuadrature,pReal))**(1.0_pReal/real(dimPlex,pReal)) + &
+ K_e = K_eA*math_det33(FAvg/real(nQuadrature,pREAL))**(1.0_pREAL/real(dimPlex,pREAL)) + &
(matmul(matmul(transpose(BMatAvg), &
reshape(FInv(1:dimPlex,1:dimPlex),shape=[dimPlex**2,1_pPETSCINT],order=[2,1])),MatB) + &
- K_eB)/real(dimPlex,pReal)
+ K_eB)/real(dimPlex,pREAL)
else
K_e = K_eA
end if
@@ -662,7 +662,7 @@ subroutine FEM_mechanical_forward(guess,timeinc,timeinc_old,fieldBC)
type(tFieldBC), intent(in) :: &
fieldBC
- real(pReal), intent(in) :: &
+ real(pREAL), intent(in) :: &
timeinc_old, &
timeinc
logical, intent(in) :: &
@@ -686,13 +686,13 @@ subroutine FEM_mechanical_forward(guess,timeinc,timeinc_old,fieldBC)
CHKERRQ(err_PETSc)
call DMGetLocalVector(dm_local,x_local,err_PETSc)
CHKERRQ(err_PETSc)
- call VecSet(x_local,0.0_pReal,err_PETSc)
+ call VecSet(x_local,0.0_pREAL,err_PETSc)
CHKERRQ(err_PETSc)
call DMGlobalToLocalBegin(dm_local,solution,INSERT_VALUES,x_local,err_PETSc) !< retrieve my partition of global solution vector
CHKERRQ(err_PETSc)
call DMGlobalToLocalEnd(dm_local,solution,INSERT_VALUES,x_local,err_PETSc)
CHKERRQ(err_PETSc)
- call VecAXPY(solution_local,1.0_pReal,x_local,err_PETSc)
+ call VecAXPY(solution_local,1.0_pREAL,x_local,err_PETSc)
CHKERRQ(err_PETSc)
do field = 1, dimPlex; do face = 1, mesh_Nboundaries
if (fieldBC%componentBC(field)%Mask(face)) then
@@ -701,7 +701,7 @@ subroutine FEM_mechanical_forward(guess,timeinc,timeinc_old,fieldBC)
call DMGetStratumIS(dm_local,'Face Sets',mesh_boundaries(face),bcPoints,err_PETSc)
CHKERRQ(err_PETSc)
call utilities_projectBCValues(solution_local,section,0_pPETSCINT,field-1,bcPoints, &
- 0.0_pReal,fieldBC%componentBC(field)%Value(face),timeinc_old)
+ 0.0_pREAL,fieldBC%componentBC(field)%Value(face),timeinc_old)
call ISDestroy(bcPoints,err_PETSc)
CHKERRQ(err_PETSc)
end if
@@ -746,7 +746,7 @@ subroutine FEM_mechanical_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reaso
print'(/,1x,a,a,i0,a,f0.3)', trim(incInfo), &
' @ Iteration ',PETScIter,' mechanical residual norm = ',fnorm/divTol
print'(/,1x,a,/,2(3(2x,f12.4,1x)/),3(2x,f12.4,1x))', &
- 'Piola--Kirchhoff stress / MPa =',transpose(P_av)*1.e-6_pReal
+ 'Piola--Kirchhoff stress / MPa =',transpose(P_av)*1.e-6_pREAL
flush(IO_STDOUT)
end subroutine FEM_mechanical_converged
@@ -759,7 +759,7 @@ subroutine FEM_mechanical_updateCoords()
PetscReal, pointer, dimension(:,:) :: &
nodeCoords !< nodal coordinates (3,Nnodes)
- real(pReal), pointer, dimension(:,:,:) :: &
+ real(pREAL), pointer, dimension(:,:,:) :: &
ipCoords !< ip coordinates (3,nQuadrature,mesh_NcpElems)
integer :: &
@@ -777,7 +777,7 @@ subroutine FEM_mechanical_updateCoords()
PetscQuadrature :: mechQuad
PetscReal, dimension(:), pointer :: basisField, basisFieldDer, &
nodeCoords_linear !< nodal coordinates (dimPlex*Nnodes)
- real(pReal), dimension(:), pointer :: x_scal
+ real(pREAL), dimension(:), pointer :: x_scal
call SNESGetDM(mechanical_snes,dm_local,err_PETSc)
CHKERRQ(err_PETSc)
@@ -793,7 +793,7 @@ subroutine FEM_mechanical_updateCoords()
! write cell vertex displacements
call DMPlexGetDepthStratum(dm_local,0_pPETSCINT,pStart,pEnd,err_PETSc)
CHKERRQ(err_PETSc)
- allocate(nodeCoords(3,pStart:pEnd-1),source=0.0_pReal)
+ allocate(nodeCoords(3,pStart:pEnd-1),source=0.0_pREAL)
call VecGetArrayF90(x_local,nodeCoords_linear,err_PETSc)
CHKERRQ(err_PETSc)
do p=pStart, pEnd-1
@@ -811,7 +811,7 @@ subroutine FEM_mechanical_updateCoords()
CHKERRQ(err_PETSc)
call PetscDSGetTabulation(mechQuad,0_pPETSCINT,basisField,basisFieldDer,err_PETSc)
CHKERRQ(err_PETSc)
- allocate(ipCoords(3,nQuadrature,mesh_NcpElems),source=0.0_pReal)
+ allocate(ipCoords(3,nQuadrature,mesh_NcpElems),source=0.0_pREAL)
do c=cellStart,cellEnd-1_pPETSCINT
qOffset=0
call DMPlexVecGetClosure(dm_local,section,x_local,c,x_scal,err_PETSc) !< get nodal coordinates of each element
diff --git a/src/misc.f90 b/src/misc.f90
index a56ea87c1..0ba3d6970 100644
--- a/src/misc.f90
+++ b/src/misc.f90
@@ -11,9 +11,9 @@ module misc
interface misc_optional
module procedure misc_optional_bool
- module procedure misc_optional_integer
+ module procedure misc_optional_int
module procedure misc_optional_real
- module procedure misc_optional_string
+ module procedure misc_optional_str
end interface misc_optional
public :: &
@@ -57,7 +57,7 @@ end function misc_optional_bool
!--------------------------------------------------------------------------------------------------
!> @brief Return integer value if given, otherwise default.
!--------------------------------------------------------------------------------------------------
-pure function misc_optional_integer(given,default) result(var)
+pure function misc_optional_int(given,default) result(var)
integer, intent(in), optional :: given
integer, intent(in) :: default
@@ -70,7 +70,7 @@ pure function misc_optional_integer(given,default) result(var)
var = default
end if
-end function misc_optional_integer
+end function misc_optional_int
!--------------------------------------------------------------------------------------------------
@@ -78,9 +78,9 @@ end function misc_optional_integer
!--------------------------------------------------------------------------------------------------
pure function misc_optional_real(given,default) result(var)
- real(pReal), intent(in), optional :: given
- real(pReal), intent(in) :: default
- real(pReal) :: var
+ real(pREAL), intent(in), optional :: given
+ real(pREAL), intent(in) :: default
+ real(pREAL) :: var
if (present(given)) then
@@ -95,7 +95,7 @@ end function misc_optional_real
!--------------------------------------------------------------------------------------------------
!> @brief Return string value if given, otherwise default.
!--------------------------------------------------------------------------------------------------
-pure function misc_optional_string(given,default) result(var)
+pure function misc_optional_str(given,default) result(var)
character(len=*), intent(in), optional :: given
character(len=*), intent(in) :: default
@@ -108,7 +108,7 @@ pure function misc_optional_string(given,default) result(var)
var = default
end if
-end function misc_optional_string
+end function misc_optional_str
!--------------------------------------------------------------------------------------------------
@@ -116,31 +116,31 @@ end function misc_optional_string
!--------------------------------------------------------------------------------------------------
subroutine misc_selfTest()
- real(pReal) :: r
+ real(pREAL) :: r
call random_number(r)
- if (test_str('DAMASK') /= 'DAMASK') error stop 'optional_string, present'
- if (test_str() /= 'default') error stop 'optional_string, not present'
- if (misc_optional(default='default') /= 'default') error stop 'optional_string, default only'
+ if (test_str('DAMASK') /= 'DAMASK') error stop 'optional_str, present'
+ if (test_str() /= 'default') error stop 'optional_str, not present'
+ if (misc_optional(default='default') /= 'default') error stop 'optional_str, default only'
if (test_int(20191102) /= 20191102) error stop 'optional_int, present'
if (test_int() /= 42) error stop 'optional_int, not present'
if (misc_optional(default=20191102) /= 20191102) error stop 'optional_int, default only'
- if (dNeq(test_real(r),r)) error stop 'optional_float, present'
- if (dNeq(test_real(),0.0_pReal)) error stop 'optional_float, not present'
- if (dNeq(misc_optional(default=r),r)) error stop 'optional_float, default only'
- if (test_bool(r<0.5_pReal) .neqv. r<0.5_pReal) error stop 'optional_bool, present'
+ if (dNeq(test_real(r),r)) error stop 'optional_real, present'
+ if (dNeq(test_real(),0.0_pREAL)) error stop 'optional_real, not present'
+ if (dNeq(misc_optional(default=r),r)) error stop 'optional_real, default only'
+ if (test_bool(r<0.5_pREAL) .neqv. r<0.5_pREAL) error stop 'optional_bool, present'
if (.not. test_bool()) error stop 'optional_bool, not present'
- if (misc_optional(default=r>0.5_pReal) .neqv. r>0.5_pReal) error stop 'optional_bool, default only'
+ if (misc_optional(default=r>0.5_pREAL) .neqv. r>0.5_pREAL) error stop 'optional_bool, default only'
contains
function test_str(str_in) result(str_out)
- character(len=:), allocatable :: str_out
+ character(len=:), allocatable :: str_out
character(len=*), intent(in), optional :: str_in
- str_out = misc_optional_string(str_in,'default')
+ str_out = misc_optional_str(str_in,'default')
end function test_str
@@ -151,18 +151,18 @@ contains
integer, intent(in), optional :: int_in
- int_out = misc_optional_integer(int_in,42)
+ int_out = misc_optional_int(int_in,42)
end function test_int
function test_real(real_in) result(real_out)
- real(pReal) :: real_out
- real(pReal), intent(in), optional :: real_in
+ real(pREAL) :: real_out
+ real(pREAL), intent(in), optional :: real_in
- real_out = misc_optional_real(real_in,0.0_pReal)
+ real_out = misc_optional_real(real_in,0.0_pREAL)
end function test_real
diff --git a/src/parallelization.f90 b/src/parallelization.f90
index 6bca36c2a..46b94af53 100644
--- a/src/parallelization.f90
+++ b/src/parallelization.f90
@@ -39,8 +39,8 @@ module parallelization
public :: parallelization_bcast_str
contains
-subroutine parallelization_bcast_str(string)
- character(len=:), allocatable, intent(inout) :: string
+subroutine parallelization_bcast_str(str)
+ character(len=:), allocatable, intent(inout) :: str
end subroutine parallelization_bcast_str
#else
@@ -135,8 +135,8 @@ subroutine parallelization_init()
call MPI_Type_size(MPI_DOUBLE,typeSize,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) &
error stop 'Could not determine size of MPI_DOUBLE'
- if (typeSize*8_MPI_INTEGER_KIND /= int(storage_size(0.0_pReal),MPI_INTEGER_KIND)) &
- error stop 'Mismatch between MPI_DOUBLE and DAMASK pReal'
+ if (typeSize*8_MPI_INTEGER_KIND /= int(storage_size(0.0_pREAL),MPI_INTEGER_KIND)) &
+ error stop 'Mismatch between MPI_DOUBLE and DAMASK pREAL'
!$ call get_environment_variable(name='OMP_NUM_THREADS',value=NumThreadsString,STATUS=got_env)
!$ if (got_env /= 0) then
@@ -171,18 +171,18 @@ end subroutine parallelization_chkerr
!--------------------------------------------------------------------------------------------------
!> @brief Broadcast a string from process 0.
!--------------------------------------------------------------------------------------------------
-subroutine parallelization_bcast_str(string)
+subroutine parallelization_bcast_str(str)
- character(len=:), allocatable, intent(inout) :: string
+ character(len=:), allocatable, intent(inout) :: str
integer(MPI_INTEGER_KIND) :: strlen, err_MPI
- if (worldrank == 0) strlen = len(string,MPI_INTEGER_KIND)
+ if (worldrank == 0) strlen = len(str,MPI_INTEGER_KIND)
call MPI_Bcast(strlen,1_MPI_INTEGER_KIND,MPI_INTEGER,0_MPI_INTEGER_KIND,MPI_COMM_WORLD, err_MPI)
- if (worldrank /= 0) allocate(character(len=strlen)::string)
+ if (worldrank /= 0) allocate(character(len=strlen)::str)
- call MPI_Bcast(string,strlen,MPI_CHARACTER,0_MPI_INTEGER_KIND,MPI_COMM_WORLD, err_MPI)
+ call MPI_Bcast(str,strlen,MPI_CHARACTER,0_MPI_INTEGER_KIND,MPI_COMM_WORLD, err_MPI)
end subroutine parallelization_bcast_str
diff --git a/src/phase.f90 b/src/phase.f90
index 11795f3d6..f889a854f 100644
--- a/src/phase.f90
+++ b/src/phase.f90
@@ -29,15 +29,15 @@ module phase
sizeDotState = 0, & !< size of dot state, i.e. state(1:sizeDot) follows time evolution by dotState rates
offsetDeltaState = 0, & !< index offset of delta state
sizeDeltaState = 0 !< size of delta state, i.e. state(offset+1:offset+sizeDelta) follows time evolution by deltaState increments
- real(pReal), allocatable, dimension(:) :: &
+ real(pREAL), allocatable, dimension(:) :: &
atol
! http://stackoverflow.com/questions/3948210
- real(pReal), pointer, dimension(:,:), contiguous :: & !< is basically an allocatable+target, but in a type needs to be pointer
+ real(pREAL), pointer, dimension(:,:), contiguous :: & !< is basically an allocatable+target, but in a type needs to be pointer
state0, &
state, & !< state
dotState, & !< rate of state change
deltaState !< increment of state change
- real(pReal), pointer, dimension(:,:) :: &
+ real(pREAL), pointer, dimension(:,:) :: &
deltaState2
end type
@@ -51,8 +51,8 @@ module phase
character(len=2), allocatable, dimension(:) :: phase_lattice
- real(pReal), allocatable, dimension(:) :: phase_cOverA
- real(pReal), allocatable, dimension(:) :: phase_rho
+ real(pREAL), allocatable, dimension(:) :: phase_cOverA
+ real(pREAL), allocatable, dimension(:) :: phase_rho
type(tRotationContainer), dimension(:), allocatable :: &
phase_O_0, &
@@ -63,7 +63,7 @@ module phase
iJacoLpresiduum, & !< frequency of Jacobian update of residuum in Lp
nState, & !< state loop limit
nStress !< stress loop limit
- real(pReal) :: &
+ real(pREAL) :: &
subStepMinCryst, & !< minimum (relative) size of sub-step allowed during cutback
subStepSizeCryst, & !< size of first substep when cutback
subStepSizeLp, & !< size of first substep when cutback in Lp calculation
@@ -133,11 +133,11 @@ module phase
module function phase_mechanical_dPdF(Delta_t,co,ce) result(dPdF)
- real(pReal), intent(in) :: Delta_t
+ real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: &
co, & !< counter in constituent loop
ce
- real(pReal), dimension(3,3,3,3) :: dPdF
+ real(pREAL), dimension(3,3,3,3) :: dPdF
end function phase_mechanical_dPdF
module subroutine mechanical_restartWrite(groupHandle,ph)
@@ -172,105 +172,105 @@ module phase
module function mechanical_S(ph,en) result(S)
integer, intent(in) :: ph,en
- real(pReal), dimension(3,3) :: S
+ real(pREAL), dimension(3,3) :: S
end function mechanical_S
module function mechanical_L_p(ph,en) result(L_p)
integer, intent(in) :: ph,en
- real(pReal), dimension(3,3) :: L_p
+ real(pREAL), dimension(3,3) :: L_p
end function mechanical_L_p
module function mechanical_F_e(ph,en) result(F_e)
integer, intent(in) :: ph,en
- real(pReal), dimension(3,3) :: F_e
+ real(pREAL), dimension(3,3) :: F_e
end function mechanical_F_e
module function mechanical_F_i(ph,en) result(F_i)
integer, intent(in) :: ph,en
- real(pReal), dimension(3,3) :: F_i
+ real(pREAL), dimension(3,3) :: F_i
end function mechanical_F_i
module function phase_F(co,ce) result(F)
integer, intent(in) :: co, ce
- real(pReal), dimension(3,3) :: F
+ real(pREAL), dimension(3,3) :: F
end function phase_F
module function phase_P(co,ce) result(P)
integer, intent(in) :: co, ce
- real(pReal), dimension(3,3) :: P
+ real(pREAL), dimension(3,3) :: P
end function phase_P
pure module function thermal_T(ph,en) result(T)
integer, intent(in) :: ph,en
- real(pReal) :: T
+ real(pREAL) :: T
end function thermal_T
module function thermal_dot_T(ph,en) result(dot_T)
integer, intent(in) :: ph,en
- real(pReal) :: dot_T
+ real(pREAL) :: dot_T
end function thermal_dot_T
module function damage_phi(ph,en) result(phi)
integer, intent(in) :: ph,en
- real(pReal) :: phi
+ real(pREAL) :: phi
end function damage_phi
module subroutine phase_set_F(F,co,ce)
- real(pReal), dimension(3,3), intent(in) :: F
+ real(pREAL), dimension(3,3), intent(in) :: F
integer, intent(in) :: co, ce
end subroutine phase_set_F
module subroutine phase_thermal_setField(T,dot_T, co,ce)
- real(pReal), intent(in) :: T, dot_T
+ real(pREAL), intent(in) :: T, dot_T
integer, intent(in) :: co, ce
end subroutine phase_thermal_setField
module subroutine phase_set_phi(phi,co,ce)
- real(pReal), intent(in) :: phi
+ real(pREAL), intent(in) :: phi
integer, intent(in) :: co, ce
end subroutine phase_set_phi
module function phase_mu_phi(co,ce) result(mu)
integer, intent(in) :: co, ce
- real(pReal) :: mu
+ real(pREAL) :: mu
end function phase_mu_phi
module function phase_K_phi(co,ce) result(K)
integer, intent(in) :: co, ce
- real(pReal), dimension(3,3) :: K
+ real(pREAL), dimension(3,3) :: K
end function phase_K_phi
module function phase_mu_T(co,ce) result(mu)
integer, intent(in) :: co, ce
- real(pReal) :: mu
+ real(pREAL) :: mu
end function phase_mu_T
module function phase_K_T(co,ce) result(K)
integer, intent(in) :: co, ce
- real(pReal), dimension(3,3) :: K
+ real(pREAL), dimension(3,3) :: K
end function phase_K_T
! == cleaned:end ===================================================================================
module function phase_thermal_constitutive(Delta_t,ph,en) result(converged_)
- real(pReal), intent(in) :: Delta_t
+ real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: ph, en
logical :: converged_
end function phase_thermal_constitutive
module function phase_damage_constitutive(Delta_t,co,ce) result(converged_)
- real(pReal), intent(in) :: Delta_t
+ real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: co, ce
logical :: converged_
end function phase_damage_constitutive
module function phase_mechanical_constitutive(Delta_t,co,ce) result(converged_)
- real(pReal), intent(in) :: Delta_t
+ real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: co, ce
logical :: converged_
end function phase_mechanical_constitutive
@@ -278,25 +278,25 @@ module phase
!ToDo: Merge all the stiffness functions
module function phase_homogenizedC66(ph,en) result(C)
integer, intent(in) :: ph, en
- real(pReal), dimension(6,6) :: C
+ real(pREAL), dimension(6,6) :: C
end function phase_homogenizedC66
module function phase_damage_C66(C66,ph,en) result(C66_degraded)
- real(pReal), dimension(6,6), intent(in) :: C66
+ real(pREAL), dimension(6,6), intent(in) :: C66
integer, intent(in) :: ph,en
- real(pReal), dimension(6,6) :: C66_degraded
+ real(pREAL), dimension(6,6) :: C66_degraded
end function phase_damage_C66
module function phase_f_phi(phi,co,ce) result(f)
integer, intent(in) :: ce,co
- real(pReal), intent(in) :: &
+ real(pREAL), intent(in) :: &
phi !< damage parameter
- real(pReal) :: &
+ real(pREAL) :: &
f
end function phase_f_phi
module function phase_f_T(ph,en) result(f)
integer, intent(in) :: ph, en
- real(pReal) :: f
+ real(pREAL) :: f
end function phase_f_T
module subroutine plastic_nonlocal_updateCompatibility(orientation,ph,ip,el)
@@ -316,11 +316,11 @@ module phase
module subroutine damage_anisobrittle_LiAndItsTangent(L_i, dL_i_dM_i, M_i, ph,en)
integer, intent(in) :: ph, en
- real(pReal), intent(in), dimension(3,3) :: &
+ real(pREAL), intent(in), dimension(3,3) :: &
M_i
- real(pReal), intent(out), dimension(3,3) :: &
+ real(pREAL), intent(out), dimension(3,3) :: &
L_i !< damage velocity gradient
- real(pReal), intent(out), dimension(3,3,3,3) :: &
+ real(pREAL), intent(out), dimension(3,3,3,3) :: &
dL_i_dM_i !< derivative of L_i with respect to M_i
end subroutine damage_anisobrittle_LiAndItsTangent
@@ -389,7 +389,7 @@ subroutine phase_init
phases => config_material%get_dict('phase')
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_O_0(phases%length))
@@ -398,12 +398,12 @@ subroutine phase_init
phase => phases%get_dict(ph)
refs = config_listReferences(phase,indent=3)
if (len(refs) > 0) print'(/,1x,a)', refs
- phase_lattice(ph) = phase%get_asString('lattice')
+ phase_lattice(ph) = phase%get_asStr('lattice')
if (all(phase_lattice(ph) /= ['cF','cI','hP','tI'])) &
- call IO_error(130,ext_msg='phase_init: '//phase%get_asString('lattice'))
+ call IO_error(130,ext_msg='phase_init: '//phase%get_asStr('lattice'))
if (any(phase_lattice(ph) == ['hP','tI'])) &
- phase_cOverA(ph) = phase%get_asFloat('c/a')
- phase_rho(ph) = phase%get_asFloat('rho',defaultVal=0.0_pReal)
+ phase_cOverA(ph) = phase%get_asReal('c/a')
+ phase_rho(ph) = phase%get_asReal('rho',defaultVal=0.0_pREAL)
allocate(phase_O_0(ph)%data(count(material_ID_phase==ph)))
end do
@@ -454,13 +454,13 @@ subroutine phase_allocateState(state, &
state%offsetDeltaState = sizeState-sizeDeltaState ! deltaState occupies latter part of state by definition
end if
- allocate(state%atol (sizeState), source=0.0_pReal)
- allocate(state%state0 (sizeState,NEntries), source=0.0_pReal)
- allocate(state%state (sizeState,NEntries), source=0.0_pReal)
+ allocate(state%atol (sizeState), source=0.0_pREAL)
+ allocate(state%state0 (sizeState,NEntries), source=0.0_pREAL)
+ allocate(state%state (sizeState,NEntries), source=0.0_pREAL)
- allocate(state%dotState (sizeDotState,NEntries), source=0.0_pReal)
+ allocate(state%dotState (sizeDotState,NEntries), source=0.0_pREAL)
- allocate(state%deltaState (sizeDeltaState,NEntries), source=0.0_pReal)
+ allocate(state%deltaState (sizeDeltaState,NEntries), source=0.0_pREAL)
state%deltaState2 => state%state(state%offsetDeltaState+1: &
state%offsetDeltaState+state%sizeDeltaState,:)
@@ -538,27 +538,27 @@ subroutine crystallite_init()
num_crystallite => config_numerics%get_dict('crystallite',defaultVal=emptyDict)
- num%subStepMinCryst = num_crystallite%get_asFloat ('subStepMin', defaultVal=1.0e-3_pReal)
- num%subStepSizeCryst = num_crystallite%get_asFloat ('subStepSize', defaultVal=0.25_pReal)
- num%stepIncreaseCryst = num_crystallite%get_asFloat ('stepIncrease', defaultVal=1.5_pReal)
- num%subStepSizeLp = num_crystallite%get_asFloat ('subStepSizeLp', defaultVal=0.5_pReal)
- num%subStepSizeLi = num_crystallite%get_asFloat ('subStepSizeLi', defaultVal=0.5_pReal)
- num%rtol_crystalliteState = num_crystallite%get_asFloat ('rtol_State', defaultVal=1.0e-6_pReal)
- num%rtol_crystalliteStress = num_crystallite%get_asFloat ('rtol_Stress', defaultVal=1.0e-6_pReal)
- num%atol_crystalliteStress = num_crystallite%get_asFloat ('atol_Stress', defaultVal=1.0e-8_pReal)
- num%iJacoLpresiduum = num_crystallite%get_asInt ('iJacoLpresiduum', defaultVal=1)
- num%nState = num_crystallite%get_asInt ('nState', defaultVal=20)
- num%nStress = num_crystallite%get_asInt ('nStress', defaultVal=40)
+ num%subStepMinCryst = num_crystallite%get_asReal ('subStepMin', defaultVal=1.0e-3_pREAL)
+ num%subStepSizeCryst = num_crystallite%get_asReal ('subStepSize', defaultVal=0.25_pREAL)
+ num%stepIncreaseCryst = num_crystallite%get_asReal ('stepIncrease', defaultVal=1.5_pREAL)
+ num%subStepSizeLp = num_crystallite%get_asReal ('subStepSizeLp', defaultVal=0.5_pREAL)
+ num%subStepSizeLi = num_crystallite%get_asReal ('subStepSizeLi', defaultVal=0.5_pREAL)
+ num%rtol_crystalliteState = num_crystallite%get_asReal ('rtol_State', defaultVal=1.0e-6_pREAL)
+ num%rtol_crystalliteStress = num_crystallite%get_asReal ('rtol_Stress', defaultVal=1.0e-6_pREAL)
+ num%atol_crystalliteStress = num_crystallite%get_asReal ('atol_Stress', defaultVal=1.0e-8_pREAL)
+ num%iJacoLpresiduum = num_crystallite%get_asInt ('iJacoLpresiduum', defaultVal=1)
+ num%nState = num_crystallite%get_asInt ('nState', defaultVal=20)
+ num%nStress = num_crystallite%get_asInt ('nStress', defaultVal=40)
extmsg = ''
- if (num%subStepMinCryst <= 0.0_pReal) extmsg = trim(extmsg)//' subStepMinCryst'
- if (num%subStepSizeCryst <= 0.0_pReal) extmsg = trim(extmsg)//' subStepSizeCryst'
- if (num%stepIncreaseCryst <= 0.0_pReal) extmsg = trim(extmsg)//' stepIncreaseCryst'
- if (num%subStepSizeLp <= 0.0_pReal) extmsg = trim(extmsg)//' subStepSizeLp'
- if (num%subStepSizeLi <= 0.0_pReal) extmsg = trim(extmsg)//' subStepSizeLi'
- if (num%rtol_crystalliteState <= 0.0_pReal) extmsg = trim(extmsg)//' rtol_crystalliteState'
- if (num%rtol_crystalliteStress <= 0.0_pReal) extmsg = trim(extmsg)//' rtol_crystalliteStress'
- if (num%atol_crystalliteStress <= 0.0_pReal) extmsg = trim(extmsg)//' atol_crystalliteStress'
+ if (num%subStepMinCryst <= 0.0_pREAL) extmsg = trim(extmsg)//' subStepMinCryst'
+ if (num%subStepSizeCryst <= 0.0_pREAL) extmsg = trim(extmsg)//' subStepSizeCryst'
+ if (num%stepIncreaseCryst <= 0.0_pREAL) extmsg = trim(extmsg)//' stepIncreaseCryst'
+ if (num%subStepSizeLp <= 0.0_pREAL) extmsg = trim(extmsg)//' subStepSizeLp'
+ if (num%subStepSizeLi <= 0.0_pREAL) extmsg = trim(extmsg)//' subStepSizeLi'
+ if (num%rtol_crystalliteState <= 0.0_pREAL) extmsg = trim(extmsg)//' rtol_crystalliteState'
+ if (num%rtol_crystalliteStress <= 0.0_pREAL) extmsg = trim(extmsg)//' rtol_crystalliteStress'
+ if (num%atol_crystalliteStress <= 0.0_pREAL) extmsg = trim(extmsg)//' atol_crystalliteStress'
if (num%iJacoLpresiduum < 1) extmsg = trim(extmsg)//' iJacoLpresiduum'
if (num%nState < 1) extmsg = trim(extmsg)//' nState'
if (num%nStress < 1) extmsg = trim(extmsg)//' nStress'
@@ -615,13 +615,13 @@ end subroutine crystallite_orientations
!--------------------------------------------------------------------------------------------------
function crystallite_push33ToRef(co,ce, tensor33)
- real(pReal), dimension(3,3), intent(in) :: tensor33
+ real(pREAL), dimension(3,3), intent(in) :: tensor33
integer, intent(in):: &
co, &
ce
- real(pReal), dimension(3,3) :: crystallite_push33ToRef
+ real(pREAL), dimension(3,3) :: crystallite_push33ToRef
- real(pReal), dimension(3,3) :: T
+ real(pREAL), dimension(3,3) :: T
integer :: ph, en
@@ -639,9 +639,9 @@ end function crystallite_push33ToRef
!--------------------------------------------------------------------------------------------------
logical pure function converged(residuum,state,atol)
- real(pReal), intent(in), dimension(:) ::&
+ real(pREAL), intent(in), dimension(:) ::&
residuum, state, atol
- real(pReal) :: &
+ real(pREAL) :: &
rTol
rTol = num%rTol_crystalliteState
diff --git a/src/phase_damage.f90 b/src/phase_damage.f90
index df5e00575..729309b82 100644
--- a/src/phase_damage.f90
+++ b/src/phase_damage.f90
@@ -4,9 +4,9 @@
submodule(phase) damage
type :: tDamageParameters
- real(pReal) :: &
- mu = 0.0_pReal, & !< viscosity
- l_c = 0.0_pReal !< characteristic length
+ real(pREAL) :: &
+ mu = 0.0_pREAL, & !< viscosity
+ l_c = 0.0_pREAL !< characteristic length
end type tDamageParameters
enum, bind(c); enumerator :: &
@@ -19,7 +19,7 @@ submodule(phase) damage
type :: tDataContainer
- real(pReal), dimension(:), allocatable :: phi
+ real(pREAL), dimension(:), allocatable :: phi
end type tDataContainer
integer(kind(DAMAGE_UNDEFINED_ID)), dimension(:), allocatable :: &
@@ -42,16 +42,16 @@ submodule(phase) damage
module subroutine isobrittle_deltaState(C, Fe, ph, en)
integer, intent(in) :: ph,en
- real(pReal), intent(in), dimension(3,3) :: &
+ real(pREAL), intent(in), dimension(3,3) :: &
Fe
- real(pReal), intent(in), dimension(6,6) :: &
+ real(pREAL), intent(in), dimension(6,6) :: &
C
end subroutine isobrittle_deltaState
module subroutine anisobrittle_dotState(M_i, ph, en)
integer, intent(in) :: ph,en
- real(pReal), intent(in), dimension(3,3) :: &
+ real(pREAL), intent(in), dimension(3,3) :: &
M_i
end subroutine anisobrittle_dotState
@@ -99,7 +99,7 @@ module subroutine damage_init()
Nmembers = count(material_ID_phase == ph)
- allocate(current(ph)%phi(Nmembers),source=1.0_pReal)
+ allocate(current(ph)%phi(Nmembers),source=1.0_pREAL)
phase => phases%get_dict(ph)
source => phase%get_dict('damage',defaultVal=emptyDict)
@@ -108,8 +108,8 @@ module subroutine damage_init()
refs = config_listReferences(source,indent=3)
if (len(refs) > 0) print'(/,1x,a)', refs
damage_active = .true.
- param(ph)%mu = source%get_asFloat('mu')
- param(ph)%l_c = source%get_asFloat('l_c')
+ param(ph)%mu = source%get_asReal('mu')
+ param(ph)%l_c = source%get_asReal('l_c')
end if
end do
@@ -131,7 +131,7 @@ end subroutine damage_init
!--------------------------------------------------------------------------------------------------
module function phase_damage_constitutive(Delta_t,co,ce) result(converged_)
- real(pReal), intent(in) :: Delta_t
+ real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: &
co, &
ce
@@ -154,9 +154,9 @@ end function phase_damage_constitutive
!--------------------------------------------------------------------------------------------------
module function phase_damage_C66(C66,ph,en) result(C66_degraded)
- real(pReal), dimension(6,6), intent(in) :: C66
+ real(pREAL), dimension(6,6), intent(in) :: C66
integer, intent(in) :: ph,en
- real(pReal), dimension(6,6) :: C66_degraded
+ real(pREAL), dimension(6,6) :: C66_degraded
damageType: select case (phase_damage(ph))
@@ -195,9 +195,9 @@ end subroutine damage_restore
module function phase_f_phi(phi,co,ce) result(f)
integer, intent(in) :: ce,co
- real(pReal), intent(in) :: &
+ real(pREAL), intent(in) :: &
phi !< damage parameter
- real(pReal) :: &
+ real(pREAL) :: &
f
integer :: &
@@ -209,10 +209,10 @@ module function phase_f_phi(phi,co,ce) result(f)
select case(phase_damage(ph))
case(DAMAGE_ISOBRITTLE_ID,DAMAGE_ANISOBRITTLE_ID)
- f = 1.0_pReal &
- - phi*damageState(ph)%state(1,en)
+ f = 1.0_pREAL &
+ - 2.0_pREAL * phi*damageState(ph)%state(1,en)
case default
- f = 0.0_pReal
+ f = 0.0_pREAL
end select
end function phase_f_phi
@@ -224,7 +224,7 @@ end function phase_f_phi
!--------------------------------------------------------------------------------------------------
function integrateDamageState(Delta_t,ph,en) result(broken)
- real(pReal), intent(in) :: Delta_t
+ real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: &
ph, &
en
@@ -233,11 +233,11 @@ function integrateDamageState(Delta_t,ph,en) result(broken)
integer :: &
NiterationState, & !< number of iterations in state loop
size_so
- real(pReal) :: &
+ real(pREAL) :: &
zeta
- real(pReal), dimension(phase_damage_maxSizeDotState) :: &
+ real(pREAL), dimension(phase_damage_maxSizeDotState) :: &
r ! state residuum
- real(pReal), dimension(phase_damage_maxSizeDotState,2) :: source_dotState
+ real(pREAL), dimension(phase_damage_maxSizeDotState,2) :: source_dotState
logical :: &
converged_
@@ -254,7 +254,7 @@ function integrateDamageState(Delta_t,ph,en) result(broken)
size_so = damageState(ph)%sizeDotState
damageState(ph)%state(1:size_so,en) = damageState(ph)%state0 (1:size_so,en) &
+ damageState(ph)%dotState(1:size_so,en) * Delta_t
- source_dotState(1:size_so,2) = 0.0_pReal
+ source_dotState(1:size_so,2) = 0.0_pREAL
iteration: do NiterationState = 1, num%nState
@@ -267,7 +267,7 @@ function integrateDamageState(Delta_t,ph,en) result(broken)
zeta = damper(damageState(ph)%dotState(:,en),source_dotState(1:size_so,1),source_dotState(1:size_so,2))
damageState(ph)%dotState(:,en) = damageState(ph)%dotState(:,en) * zeta &
- + source_dotState(1:size_so,1)* (1.0_pReal - zeta)
+ + source_dotState(1:size_so,1)* (1.0_pREAL - zeta)
r(1:size_so) = damageState(ph)%state (1:size_so,en) &
- damageState(ph)%State0 (1:size_so,en) &
- damageState(ph)%dotState(1:size_so,en) * Delta_t
@@ -291,20 +291,20 @@ function integrateDamageState(Delta_t,ph,en) result(broken)
!--------------------------------------------------------------------------------------------------
!> @brief Calculate the damping for correction of state and dot state.
!--------------------------------------------------------------------------------------------------
- real(pReal) pure function damper(omega_0,omega_1,omega_2)
+ real(pREAL) pure function damper(omega_0,omega_1,omega_2)
- real(pReal), dimension(:), intent(in) :: &
+ real(pREAL), dimension(:), intent(in) :: &
omega_0, omega_1, omega_2
- real(pReal) :: dot_prod12, dot_prod22
+ real(pREAL) :: dot_prod12, dot_prod22
dot_prod12 = dot_product(omega_0-omega_1, omega_1-omega_2)
dot_prod22 = dot_product(omega_1-omega_2, omega_1-omega_2)
- if (min(dot_product(omega_0,omega_1),dot_prod12) < 0.0_pReal .and. dot_prod22 > 0.0_pReal) then
- damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22)
+ if (min(dot_product(omega_0,omega_1),dot_prod12) < 0.0_pREAL .and. dot_prod22 > 0.0_pREAL) then
+ damper = 0.75_pREAL + 0.25_pREAL * tanh(2.0_pREAL + 4.0_pREAL * dot_prod12 / dot_prod22)
else
- damper = 1.0_pReal
+ damper = 1.0_pREAL
end if
end function damper
@@ -401,7 +401,7 @@ end function phase_damage_collectDotState
module function phase_mu_phi(co,ce) result(mu)
integer, intent(in) :: co, ce
- real(pReal) :: mu
+ real(pREAL) :: mu
mu = param(material_ID_phase(co,ce))%mu
@@ -415,7 +415,7 @@ end function phase_mu_phi
module function phase_K_phi(co,ce) result(K)
integer, intent(in) :: co, ce
- real(pReal), dimension(3,3) :: K
+ real(pREAL), dimension(3,3) :: K
K = crystallite_push33ToRef(co,ce,param(material_ID_phase(co,ce))%l_c**2*math_I3)
@@ -432,7 +432,7 @@ function phase_damage_deltaState(Fe, ph, en) result(broken)
integer, intent(in) :: &
ph, &
en
- real(pReal), intent(in), dimension(3,3) :: &
+ real(pREAL), intent(in), dimension(3,3) :: &
Fe !< elastic deformation gradient
integer :: &
@@ -484,7 +484,7 @@ function source_active(source_label) result(active_source)
do ph = 1, phases%length
phase => phases%get_dict(ph)
src => phase%get_dict('damage',defaultVal=emptyDict)
- active_source(ph) = src%get_asString('type',defaultVal = 'x') == source_label
+ active_source(ph) = src%get_asStr('type',defaultVal = 'x') == source_label
end do
@@ -496,7 +496,7 @@ end function source_active
!----------------------------------------------------------------------------------------------
module subroutine phase_set_phi(phi,co,ce)
- real(pReal), intent(in) :: phi
+ real(pREAL), intent(in) :: phi
integer, intent(in) :: ce, co
@@ -508,7 +508,7 @@ end subroutine phase_set_phi
module function damage_phi(ph,en) result(phi)
integer, intent(in) :: ph, en
- real(pReal) :: phi
+ real(pREAL) :: phi
phi = current(ph)%phi(en)
diff --git a/src/phase_damage_anisobrittle.f90 b/src/phase_damage_anisobrittle.f90
index 69fa32564..788b8292c 100644
--- a/src/phase_damage_anisobrittle.f90
+++ b/src/phase_damage_anisobrittle.f90
@@ -7,17 +7,17 @@
submodule (phase:damage) anisobrittle
type :: tParameters !< container type for internal constitutive parameters
- real(pReal) :: &
+ real(pREAL) :: &
dot_o_0, & !< opening rate of cleavage planes
p !< damage rate sensitivity
- real(pReal), dimension(:), allocatable :: &
+ real(pREAL), dimension(:), allocatable :: &
s_crit, & !< critical displacement
g_crit !< critical load
- real(pReal), dimension(:,:,:,:), allocatable :: &
+ real(pREAL), dimension(:,:,:,:), allocatable :: &
cleavage_systems
integer :: &
sum_N_cl !< total number of cleavage planes
- character(len=pStringLen), allocatable, dimension(:) :: &
+ character(len=pSTRLEN), allocatable, dimension(:) :: &
output
end type tParameters
@@ -71,11 +71,11 @@ module function anisobrittle_init() result(mySources)
N_cl = src%get_as1dInt('N_cl',defaultVal=emptyIntArray)
prm%sum_N_cl = sum(abs(N_cl))
- prm%p = src%get_asFloat('p')
- prm%dot_o_0 = src%get_asFloat('dot_o_0')
+ prm%p = src%get_asReal('p')
+ prm%dot_o_0 = src%get_asReal('dot_o_0')
- prm%s_crit = src%get_as1dFloat('s_crit', requiredSize=size(N_cl))
- prm%g_crit = src%get_as1dFloat('g_crit', requiredSize=size(N_cl))
+ prm%s_crit = src%get_as1dReal('s_crit',requiredSize=size(N_cl))
+ prm%g_crit = src%get_as1dReal('g_crit',requiredSize=size(N_cl))
prm%cleavage_systems = lattice_SchmidMatrix_cleavage(N_cl,phase_lattice(ph),phase_cOverA(ph))
@@ -84,21 +84,21 @@ module function anisobrittle_init() result(mySources)
prm%g_crit = math_expand(prm%g_crit,N_cl)
#if defined (__GFORTRAN__)
- prm%output = output_as1dString(src)
+ prm%output = output_as1dStr(src)
#else
- prm%output = src%get_as1dString('output',defaultVal=emptyStringArray)
+ prm%output = src%get_as1dStr('output',defaultVal=emptyStrArray)
#endif
! sanity checks
- if (prm%p <= 0.0_pReal) extmsg = trim(extmsg)//' p'
- if (prm%dot_o_0 <= 0.0_pReal) extmsg = trim(extmsg)//' dot_o_0'
- if (any(prm%g_crit < 0.0_pReal)) extmsg = trim(extmsg)//' g_crit'
- if (any(prm%s_crit < 0.0_pReal)) extmsg = trim(extmsg)//' s_crit'
+ if (prm%p <= 0.0_pREAL) extmsg = trim(extmsg)//' p'
+ if (prm%dot_o_0 <= 0.0_pREAL) extmsg = trim(extmsg)//' dot_o_0'
+ if (any(prm%g_crit < 0.0_pREAL)) extmsg = trim(extmsg)//' g_crit'
+ if (any(prm%s_crit < 0.0_pREAL)) extmsg = trim(extmsg)//' s_crit'
Nmembers = count(material_ID_phase==ph)
call phase_allocateState(damageState(ph),Nmembers,1,1,0)
- damageState(ph)%atol = src%get_asFloat('atol_phi',defaultVal=1.0e-9_pReal)
- if (any(damageState(ph)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' atol_phi'
+ damageState(ph)%atol = src%get_asReal('atol_phi',defaultVal=1.0e-9_pREAL)
+ if (any(damageState(ph)%atol < 0.0_pREAL)) extmsg = trim(extmsg)//' atol_phi'
end associate
@@ -117,17 +117,17 @@ module subroutine anisobrittle_dotState(M_i, ph,en)
integer, intent(in) :: &
ph,en
- real(pReal), intent(in), dimension(3,3) :: &
+ real(pREAL), intent(in), dimension(3,3) :: &
M_i
integer :: &
a, i
- real(pReal) :: &
+ real(pREAL) :: &
traction, traction_crit
associate(prm => param(ph))
- damageState(ph)%dotState(1,en) = 0.0_pReal
+ damageState(ph)%dotState(1,en) = 0.0_pREAL
do a = 1, prm%sum_N_cl
traction_crit = damage_phi(ph,en)**2 * prm%g_crit(a)
do i = 1,3
@@ -135,7 +135,7 @@ module subroutine anisobrittle_dotState(M_i, ph,en)
damageState(ph)%dotState(1,en) = damageState(ph)%dotState(1,en) &
+ prm%dot_o_0 / prm%s_crit(a) &
- * (max(0.0_pReal, abs(traction) - traction_crit)/traction_crit)**prm%p
+ * (max(0.0_pREAL, abs(traction) - traction_crit)/traction_crit)**prm%p
end do
end do
end associate
@@ -173,22 +173,22 @@ module subroutine damage_anisobrittle_LiAndItsTangent(L_i, dL_i_dM_i, M_i, ph,en
integer, intent(in) :: &
ph,en
- real(pReal), intent(in), dimension(3,3) :: &
+ real(pREAL), intent(in), dimension(3,3) :: &
M_i
- real(pReal), intent(out), dimension(3,3) :: &
+ real(pREAL), intent(out), dimension(3,3) :: &
L_i !< damage velocity gradient
- real(pReal), intent(out), dimension(3,3,3,3) :: &
+ real(pREAL), intent(out), dimension(3,3,3,3) :: &
dL_i_dM_i !< derivative of L_i with respect to M_i
integer :: &
a, k, l, m, n, i
- real(pReal) :: &
+ real(pREAL) :: &
traction, traction_crit, &
udot, dudot_dt
- L_i = 0.0_pReal
- dL_i_dM_i = 0.0_pReal
+ L_i = 0.0_pREAL
+ dL_i_dM_i = 0.0_pREAL
associate(prm => param(ph))
do a = 1,prm%sum_N_cl
traction_crit = damage_phi(ph,en)**2 * prm%g_crit(a)
@@ -196,9 +196,9 @@ module subroutine damage_anisobrittle_LiAndItsTangent(L_i, dL_i_dM_i, M_i, ph,en
do i = 1, 3
traction = math_tensordot(M_i,prm%cleavage_systems(1:3,1:3,i,a))
if (abs(traction) > traction_crit + tol_math_check) then
- udot = sign(1.0_pReal,traction)* prm%dot_o_0 * ((abs(traction) - traction_crit)/traction_crit)**prm%p
+ udot = sign(1.0_pREAL,traction)* prm%dot_o_0 * ((abs(traction) - traction_crit)/traction_crit)**prm%p
L_i = L_i + udot*prm%cleavage_systems(1:3,1:3,i,a)
- dudot_dt = sign(1.0_pReal,traction)*udot*prm%p / (abs(traction) - traction_crit)
+ dudot_dt = sign(1.0_pREAL,traction)*udot*prm%p / (abs(traction) - traction_crit)
forall (k=1:3,l=1:3,m=1:3,n=1:3) &
dL_i_dM_i(k,l,m,n) = dL_i_dM_i(k,l,m,n) &
+ dudot_dt*prm%cleavage_systems(k,l,i,a) * prm%cleavage_systems(m,n,i,a)
diff --git a/src/phase_damage_isobrittle.f90 b/src/phase_damage_isobrittle.f90
index 62a2eb7ec..2efff9f7d 100644
--- a/src/phase_damage_isobrittle.f90
+++ b/src/phase_damage_isobrittle.f90
@@ -7,14 +7,14 @@
submodule(phase:damage) isobrittle
type :: tParameters !< container type for internal constitutive parameters
- real(pReal) :: &
+ real(pREAL) :: &
W_crit !< critical elastic strain energy
- character(len=pStringLen), allocatable, dimension(:) :: &
+ character(len=pSTRLEN), allocatable, dimension(:) :: &
output
end type tParameters
type :: tIsobrittleState
- real(pReal), pointer, dimension(:) :: & !< vectors along Nmembers
+ real(pREAL), pointer, dimension(:) :: & !< vectors along Nmembers
r_W !< ratio between actual and critical strain energy density
end type tIsobrittleState
@@ -64,25 +64,25 @@ module function isobrittle_init() result(mySources)
associate(prm => param(ph), dlt => deltaState(ph), stt => state(ph))
- prm%W_crit = src%get_asFloat('G_crit')/src%get_asFloat('l_c')
+ prm%W_crit = src%get_asReal('G_crit')/src%get_asReal('l_c')
print'(/,1x,a,i0,a)', 'phase ',ph,': '//phases%key(ph)
refs = config_listReferences(src,indent=3)
if (len(refs) > 0) print'(/,1x,a)', refs
#if defined (__GFORTRAN__)
- prm%output = output_as1dString(src)
+ prm%output = output_as1dStr(src)
#else
- prm%output = src%get_as1dString('output',defaultVal=emptyStringArray)
+ prm%output = src%get_as1dStr('output',defaultVal=emptyStrArray)
#endif
! sanity checks
- if (prm%W_crit <= 0.0_pReal) extmsg = trim(extmsg)//' W_crit'
+ if (prm%W_crit <= 0.0_pREAL) extmsg = trim(extmsg)//' W_crit'
Nmembers = count(material_ID_phase==ph)
call phase_allocateState(damageState(ph),Nmembers,1,0,1)
- damageState(ph)%atol = src%get_asFloat('atol_phi',defaultVal=1.0e-9_pReal)
- if (any(damageState(ph)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' atol_phi'
+ damageState(ph)%atol = src%get_asReal('atol_phi',defaultVal=1.0e-9_pREAL)
+ if (any(damageState(ph)%atol < 0.0_pREAL)) extmsg = trim(extmsg)//' atol_phi'
stt%r_W => damageState(ph)%state(1,:)
dlt%r_W => damageState(ph)%deltaState(1,:)
@@ -105,23 +105,23 @@ end function isobrittle_init
module subroutine isobrittle_deltaState(C, Fe, ph,en)
integer, intent(in) :: ph,en
- real(pReal), intent(in), dimension(3,3) :: &
+ real(pREAL), intent(in), dimension(3,3) :: &
Fe
- real(pReal), intent(in), dimension(6,6) :: &
+ real(pREAL), intent(in), dimension(6,6) :: &
C
- real(pReal), dimension(6) :: &
+ real(pREAL), dimension(6) :: &
epsilon
- real(pReal) :: &
+ real(pREAL) :: &
r_W
- epsilon = math_33toVoigt6_strain(0.5_pReal*(matmul(transpose(Fe),Fe)-math_I3))
+ epsilon = math_33toVoigt6_strain(0.5_pREAL*(matmul(transpose(Fe),Fe)-math_I3))
associate(prm => param(ph), stt => state(ph), dlt => deltaState(ph))
- r_W = (0.5_pReal*dot_product(epsilon,matmul(C,epsilon)))/prm%W_crit
- dlt%r_W(en) = merge(r_W - stt%r_W(en), 0.0_pReal, r_W > stt%r_W(en))
+ r_W = (0.5_pREAL*dot_product(epsilon,matmul(C,epsilon)))/prm%W_crit
+ dlt%r_W(en) = merge(r_W - stt%r_W(en), 0.0_pREAL, r_W > stt%r_W(en))
end associate
diff --git a/src/phase_mechanical.f90 b/src/phase_mechanical.f90
index 4049914de..0f931517a 100644
--- a/src/phase_mechanical.f90
+++ b/src/phase_mechanical.f90
@@ -57,22 +57,22 @@ submodule(phase) mechanical
integer, intent(in) :: &
ph, &
en
- real(pReal), intent(in), dimension(3,3) :: &
+ real(pREAL), intent(in), dimension(3,3) :: &
Fe, & !< elastic deformation gradient
Fi !< intermediate deformation gradient
- real(pReal), intent(out), dimension(3,3) :: &
+ real(pREAL), intent(out), dimension(3,3) :: &
S !< 2nd Piola-Kirchhoff stress tensor in lattice configuration
- real(pReal), intent(out), dimension(3,3,3,3) :: &
+ real(pREAL), intent(out), dimension(3,3,3,3) :: &
dS_dFe, & !< derivative of 2nd P-K stress with respect to elastic deformation gradient
dS_dFi !< derivative of 2nd P-K stress with respect to intermediate deformation gradient
end subroutine phase_hooke_SandItsTangents
module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,ph,en)
- real(pReal), dimension(3,3), intent(out) :: &
+ real(pREAL), dimension(3,3), intent(out) :: &
Li !< inleastic velocity gradient
- real(pReal), dimension(3,3,3,3), intent(out) :: &
+ real(pREAL), dimension(3,3,3,3), intent(out) :: &
dLi_dMi !< derivative of Li with respect to Mandel stress
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mi !< Mandel stress
integer, intent(in) :: &
ph, &
@@ -83,9 +83,9 @@ submodule(phase) mechanical
integer, intent(in) :: &
ph, &
en
- real(pReal), intent(in) :: &
+ real(pREAL), intent(in) :: &
subdt !< timestep
- real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+ real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
dotState
end function plastic_dotState
@@ -101,13 +101,13 @@ submodule(phase) mechanical
S, Fi, ph,en)
integer, intent(in) :: &
ph,en
- real(pReal), intent(in), dimension(3,3) :: &
+ real(pREAL), intent(in), dimension(3,3) :: &
S !< 2nd Piola-Kirchhoff stress
- real(pReal), intent(in), dimension(3,3) :: &
+ real(pREAL), intent(in), dimension(3,3) :: &
Fi !< intermediate deformation gradient
- real(pReal), intent(out), dimension(3,3) :: &
+ real(pREAL), intent(out), dimension(3,3) :: &
Li !< intermediate velocity gradient
- real(pReal), intent(out), dimension(3,3,3,3) :: &
+ real(pREAL), intent(out), dimension(3,3,3,3) :: &
dLi_dS, & !< derivative of Li with respect to S
dLi_dFi
@@ -118,12 +118,12 @@ submodule(phase) mechanical
S, Fi, ph,en)
integer, intent(in) :: &
ph,en
- real(pReal), intent(in), dimension(3,3) :: &
+ real(pREAL), intent(in), dimension(3,3) :: &
S, & !< 2nd Piola-Kirchhoff stress
Fi !< intermediate deformation gradient
- real(pReal), intent(out), dimension(3,3) :: &
+ real(pREAL), intent(out), dimension(3,3) :: &
Lp !< plastic velocity gradient
- real(pReal), intent(out), dimension(3,3,3,3) :: &
+ real(pREAL), intent(out), dimension(3,3,3,3) :: &
dLp_dS, &
dLp_dFi !< derivative of Lp with respect to Fi
end subroutine plastic_LpAndItsTangents
@@ -160,23 +160,23 @@ submodule(phase) mechanical
end subroutine plastic_nonlocal_result
module function plastic_dislotwin_homogenizedC(ph,en) result(homogenizedC)
- real(pReal), dimension(6,6) :: homogenizedC
+ real(pREAL), dimension(6,6) :: homogenizedC
integer, intent(in) :: ph,en
end function plastic_dislotwin_homogenizedC
pure module function elastic_C66(ph,en) result(C66)
- real(pReal), dimension(6,6) :: C66
+ real(pREAL), dimension(6,6) :: C66
integer, intent(in) :: ph, en
end function elastic_C66
pure module function elastic_mu(ph,en,isotropic_bound) result(mu)
- real(pReal) :: mu
+ real(pREAL) :: mu
integer, intent(in) :: ph, en
character(len=*), intent(in) :: isotropic_bound
end function elastic_mu
pure module function elastic_nu(ph,en,isotropic_bound) result(nu)
- real(pReal) :: nu
+ real(pREAL) :: nu
integer, intent(in) :: ph, en
character(len=*), intent(in) :: isotropic_bound
end function elastic_nu
@@ -184,7 +184,7 @@ submodule(phase) mechanical
end interface
type :: tOutput !< requested output (per phase)
- character(len=pStringLen), allocatable, dimension(:) :: &
+ character(len=pSTRLEN), allocatable, dimension(:) :: &
label
end type tOutput
type(tOutput), allocatable, dimension(:) :: output_mechanical
@@ -243,20 +243,20 @@ module subroutine mechanical_init(phases)
allocate(phase_mechanical_Fi(ph)%data(3,3,Nmembers))
allocate(phase_mechanical_Fp(ph)%data(3,3,Nmembers))
allocate(phase_mechanical_F(ph)%data(3,3,Nmembers))
- allocate(phase_mechanical_Li(ph)%data(3,3,Nmembers),source=0.0_pReal)
- allocate(phase_mechanical_Li0(ph)%data(3,3,Nmembers),source=0.0_pReal)
- allocate(phase_mechanical_Lp(ph)%data(3,3,Nmembers),source=0.0_pReal)
- allocate(phase_mechanical_Lp0(ph)%data(3,3,Nmembers),source=0.0_pReal)
- allocate(phase_mechanical_S(ph)%data(3,3,Nmembers),source=0.0_pReal)
- allocate(phase_mechanical_P(ph)%data(3,3,Nmembers),source=0.0_pReal)
- allocate(phase_mechanical_S0(ph)%data(3,3,Nmembers),source=0.0_pReal)
+ allocate(phase_mechanical_Li(ph)%data(3,3,Nmembers),source=0.0_pREAL)
+ allocate(phase_mechanical_Li0(ph)%data(3,3,Nmembers),source=0.0_pREAL)
+ allocate(phase_mechanical_Lp(ph)%data(3,3,Nmembers),source=0.0_pREAL)
+ allocate(phase_mechanical_Lp0(ph)%data(3,3,Nmembers),source=0.0_pREAL)
+ allocate(phase_mechanical_S(ph)%data(3,3,Nmembers),source=0.0_pREAL)
+ allocate(phase_mechanical_P(ph)%data(3,3,Nmembers),source=0.0_pREAL)
+ allocate(phase_mechanical_S0(ph)%data(3,3,Nmembers),source=0.0_pREAL)
phase => phases%get_dict(ph)
mech => phase%get_dict('mechanical')
#if defined(__GFORTRAN__)
- output_mechanical(ph)%label = output_as1dString(mech)
+ output_mechanical(ph)%label = output_as1dStr(mech)
#else
- output_mechanical(ph)%label = mech%get_as1dString('output',defaultVal=emptyStringArray)
+ output_mechanical(ph)%label = mech%get_as1dStr('output',defaultVal=emptyStrArray)
#endif
end do
@@ -291,7 +291,7 @@ module subroutine mechanical_init(phases)
num_crystallite => config_numerics%get_dict('crystallite',defaultVal=emptyDict)
- select case(num_crystallite%get_asString('integrator',defaultVal='FPI'))
+ select case(num_crystallite%get_asStr('integrator',defaultVal='FPI'))
case('FPI')
integrateState => integrateStateFPI
@@ -359,11 +359,11 @@ end subroutine mechanical_result
!--------------------------------------------------------------------------------------------------
function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
- real(pReal), dimension(3,3), intent(in) :: F,subFp0,subFi0
- real(pReal), intent(in) :: Delta_t
+ real(pREAL), dimension(3,3), intent(in) :: F,subFp0,subFi0
+ real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: ph, en
- real(pReal), dimension(3,3):: Fp_new, & ! plastic deformation gradient at end of timestep
+ real(pREAL), dimension(3,3):: Fp_new, & ! plastic deformation gradient at end of timestep
invFp_new, & ! inverse of Fp_new
invFp_current, & ! inverse of Fp_current
Lpguess, & ! current guess for plastic velocity gradient
@@ -386,11 +386,11 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
A, &
B, &
temp_33
- real(pReal), dimension(9) :: temp_9 ! needed for matrix inversion by LAPACK
+ real(pREAL), dimension(9) :: temp_9 ! needed for matrix inversion by LAPACK
integer, dimension(9) :: devNull_9 ! needed for matrix inversion by LAPACK
- real(pReal), dimension(9,9) :: dRLp_dLp, & ! partial derivative of residuum (Jacobian for Newton-Raphson scheme)
+ real(pREAL), dimension(9,9) :: dRLp_dLp, & ! partial derivative of residuum (Jacobian for Newton-Raphson scheme)
dRLi_dLi ! partial derivative of residuumI (Jacobian for Newton-Raphson scheme)
- real(pReal), dimension(3,3,3,3):: dS_dFe, & ! partial derivative of 2nd Piola-Kirchhoff stress
+ real(pREAL), dimension(3,3,3,3):: dS_dFe, & ! partial derivative of 2nd Piola-Kirchhoff stress
dS_dFi, &
dFe_dLp, & ! partial derivative of elastic deformation gradient
dFe_dLi, &
@@ -399,7 +399,7 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
dLi_dFi, &
dLp_dS, &
dLi_dS
- real(pReal) steplengthLp, &
+ real(pREAL) steplengthLp, &
steplengthLi, &
atol_Lp, &
atol_Li
@@ -427,8 +427,8 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
A = matmul(F,invFp_current) ! intermediate tensor needed later to calculate dFe_dLp
jacoCounterLi = 0
- steplengthLi = 1.0_pReal
- residuumLi_old = 0.0_pReal
+ steplengthLi = 1.0_pREAL
+ residuumLi_old = 0.0_pREAL
Liguess_old = Liguess
NiterationStressLi = 0
@@ -440,8 +440,8 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
Fi_new = math_inv33(invFi_new)
jacoCounterLp = 0
- steplengthLp = 1.0_pReal
- residuumLp_old = 0.0_pReal
+ steplengthLp = 1.0_pREAL
+ residuumLp_old = 0.0_pREAL
Lpguess_old = Lpguess
NiterationStressLp = 0
@@ -469,7 +469,7 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
elseif (NiterationStressLp == 1 .or. norm2(residuumLp) < norm2(residuumLp_old)) then ! not converged, but improved norm of residuum (always proceed in first iteration)...
residuumLp_old = residuumLp ! ...remember old values and...
Lpguess_old = Lpguess
- steplengthLp = 1.0_pReal ! ...proceed with normal step length (calculate new search direction)
+ steplengthLp = 1.0_pREAL ! ...proceed with normal step length (calculate new search direction)
else ! not converged and residuum not improved...
steplengthLp = num%subStepSizeLp * steplengthLp ! ...try with smaller step length in same direction
Lpguess = Lpguess_old &
@@ -509,7 +509,7 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
elseif (NiterationStressLi == 1 .or. norm2(residuumLi) < norm2(residuumLi_old)) then ! not converged, but improved norm of residuum (always proceed in first iteration)...
residuumLi_old = residuumLi ! ...remember old values and...
Liguess_old = Liguess
- steplengthLi = 1.0_pReal ! ...proceed with normal step length (calculate new search direction)
+ steplengthLi = 1.0_pREAL ! ...proceed with normal step length (calculate new search direction)
else ! not converged and residuum not improved...
steplengthLi = num%subStepSizeLi * steplengthLi ! ...try with smaller step length in same direction
Liguess = Liguess_old &
@@ -550,7 +550,7 @@ function integrateStress(F,subFp0,subFi0,Delta_t,ph,en) result(broken)
phase_mechanical_S(ph)%data(1:3,1:3,en) = S
phase_mechanical_Lp(ph)%data(1:3,1:3,en) = Lpguess
phase_mechanical_Li(ph)%data(1:3,1:3,en) = Liguess
- phase_mechanical_Fp(ph)%data(1:3,1:3,en) = Fp_new / math_det33(Fp_new)**(1.0_pReal/3.0_pReal) ! regularize
+ phase_mechanical_Fp(ph)%data(1:3,1:3,en) = Fp_new / math_det33(Fp_new)**(1.0_pREAL/3.0_pREAL) ! regularize
phase_mechanical_Fi(ph)%data(1:3,1:3,en) = Fi_new
phase_mechanical_Fe(ph)%data(1:3,1:3,en) = matmul(matmul(F,invFp_new),invFi_new)
broken = .false.
@@ -564,9 +564,9 @@ end function integrateStress
!--------------------------------------------------------------------------------------------------
function integrateStateFPI(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(broken)
- real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
- real(pReal), intent(in),dimension(:) :: subState0
- real(pReal), intent(in) :: Delta_t
+ real(pREAL), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
+ real(pREAL), intent(in),dimension(:) :: subState0
+ real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: &
ph, &
en
@@ -576,12 +576,12 @@ function integrateStateFPI(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(b
integer :: &
NiterationState, & !< number of iterations in state loop
sizeDotState
- real(pReal) :: &
+ real(pREAL) :: &
zeta
- real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+ real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
r, & ! state residuum
dotState
- real(pReal), dimension(plasticState(ph)%sizeDotState,2) :: &
+ real(pREAL), dimension(plasticState(ph)%sizeDotState,2) :: &
dotState_last
@@ -595,7 +595,7 @@ function integrateStateFPI(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(b
iteration: do NiterationState = 1, num%nState
- dotState_last(1:sizeDotState,2) = merge(dotState_last(1:sizeDotState,1),0.0_pReal, nIterationState > 1)
+ dotState_last(1:sizeDotState,2) = merge(dotState_last(1:sizeDotState,1),0.0_pREAL, nIterationState > 1)
dotState_last(1:sizeDotState,1) = dotState
broken = integrateStress(F,subFp0,subFi0,Delta_t,ph,en)
@@ -606,7 +606,7 @@ function integrateStateFPI(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(b
zeta = damper(dotState,dotState_last(1:sizeDotState,1),dotState_last(1:sizeDotState,2))
dotState = dotState * zeta &
- + dotState_last(1:sizeDotState,1) * (1.0_pReal - zeta)
+ + dotState_last(1:sizeDotState,1) * (1.0_pREAL - zeta)
r = plasticState(ph)%state(1:sizeDotState,en) &
- subState0 &
- dotState * Delta_t
@@ -625,21 +625,21 @@ function integrateStateFPI(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(b
!--------------------------------------------------------------------------------------------------
!> @brief calculate the damping for correction of state and dot state
!--------------------------------------------------------------------------------------------------
- real(pReal) pure function damper(omega_0,omega_1,omega_2)
+ real(pREAL) pure function damper(omega_0,omega_1,omega_2)
- real(pReal), dimension(:), intent(in) :: &
+ real(pREAL), dimension(:), intent(in) :: &
omega_0, omega_1, omega_2
- real(pReal) :: dot_prod12, dot_prod22
+ real(pREAL) :: dot_prod12, dot_prod22
dot_prod12 = dot_product(omega_0-omega_1, omega_1-omega_2)
dot_prod22 = dot_product(omega_1-omega_2, omega_1-omega_2)
- if (min(dot_product(omega_0,omega_1),dot_prod12) < 0.0_pReal .and. dot_prod22 > 0.0_pReal) then
- damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22)
+ if (min(dot_product(omega_0,omega_1),dot_prod12) < 0.0_pREAL .and. dot_prod22 > 0.0_pREAL) then
+ damper = 0.75_pREAL + 0.25_pREAL * tanh(2.0_pREAL + 4.0_pREAL * dot_prod12 / dot_prod22)
else
- damper = 1.0_pReal
+ damper = 1.0_pREAL
end if
end function damper
@@ -652,16 +652,16 @@ end function integrateStateFPI
!--------------------------------------------------------------------------------------------------
function integrateStateEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(broken)
- real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
- real(pReal), intent(in),dimension(:) :: subState0
- real(pReal), intent(in) :: Delta_t
+ real(pREAL), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
+ real(pREAL), intent(in),dimension(:) :: subState0
+ real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: &
ph, &
en !< grain index in grain loop
logical :: &
broken
- real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+ real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
dotState
integer :: &
sizeDotState
@@ -692,9 +692,9 @@ end function integrateStateEuler
!--------------------------------------------------------------------------------------------------
function integrateStateAdaptiveEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(broken)
- real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
- real(pReal), intent(in),dimension(:) :: subState0
- real(pReal), intent(in) :: Delta_t
+ real(pREAL), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
+ real(pREAL), intent(in),dimension(:) :: subState0
+ real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: &
ph, &
en
@@ -703,7 +703,7 @@ function integrateStateAdaptiveEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en
integer :: &
sizeDotState
- real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+ real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
r, &
dotState
@@ -715,7 +715,7 @@ function integrateStateAdaptiveEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en
sizeDotState = plasticState(ph)%sizeDotState
- r = - dotState * 0.5_pReal * Delta_t
+ r = - dotState * 0.5_pREAL * Delta_t
#ifndef __INTEL_LLVM_COMPILER
plasticState(ph)%state(1:sizeDotState,en) = subState0 + dotState*Delta_t
#else
@@ -731,7 +731,7 @@ function integrateStateAdaptiveEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en
dotState = plastic_dotState(Delta_t,ph,en)
if (any(IEEE_is_NaN(dotState))) return
- broken = .not. converged(r + 0.5_pReal * dotState * Delta_t, &
+ broken = .not. converged(r + 0.5_pREAL * dotState * Delta_t, &
plasticState(ph)%state(1:sizeDotState,en), &
plasticState(ph)%atol(1:sizeDotState))
@@ -743,22 +743,22 @@ end function integrateStateAdaptiveEuler
!---------------------------------------------------------------------------------------------------
function integrateStateRK4(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(broken)
- real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
- real(pReal), intent(in),dimension(:) :: subState0
- real(pReal), intent(in) :: Delta_t
+ real(pREAL), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
+ real(pREAL), intent(in),dimension(:) :: subState0
+ real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: ph, en
logical :: broken
- real(pReal), dimension(3,3), parameter :: &
+ real(pREAL), dimension(3,3), parameter :: &
A = reshape([&
- 0.5_pReal, 0.0_pReal, 0.0_pReal, &
- 0.0_pReal, 0.5_pReal, 0.0_pReal, &
- 0.0_pReal, 0.0_pReal, 1.0_pReal],&
+ 0.5_pREAL, 0.0_pREAL, 0.0_pREAL, &
+ 0.0_pREAL, 0.5_pREAL, 0.0_pREAL, &
+ 0.0_pREAL, 0.0_pREAL, 1.0_pREAL],&
shape(A))
- real(pReal), dimension(3), parameter :: &
- C = [0.5_pReal, 0.5_pReal, 1.0_pReal]
- real(pReal), dimension(4), parameter :: &
- B = [6.0_pReal, 3.0_pReal, 3.0_pReal, 6.0_pReal]**(-1)
+ real(pREAL), dimension(3), parameter :: &
+ C = [0.5_pREAL, 0.5_pREAL, 1.0_pREAL]
+ real(pREAL), dimension(4), parameter :: &
+ B = [6.0_pREAL, 3.0_pREAL, 3.0_pREAL, 6.0_pREAL]**(-1)
broken = integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en,A,B,C)
@@ -771,29 +771,29 @@ end function integrateStateRK4
!---------------------------------------------------------------------------------------------------
function integrateStateRKCK45(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en) result(broken)
- real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
- real(pReal), intent(in),dimension(:) :: subState0
- real(pReal), intent(in) :: Delta_t
+ real(pREAL), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
+ real(pREAL), intent(in),dimension(:) :: subState0
+ real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: ph, en
logical :: broken
- real(pReal), dimension(5,5), parameter :: &
+ real(pREAL), dimension(5,5), parameter :: &
A = reshape([&
- 1._pReal/5._pReal, .0_pReal, .0_pReal, .0_pReal, .0_pReal, &
- 3._pReal/40._pReal, 9._pReal/40._pReal, .0_pReal, .0_pReal, .0_pReal, &
- 3_pReal/10._pReal, -9._pReal/10._pReal, 6._pReal/5._pReal, .0_pReal, .0_pReal, &
- -11._pReal/54._pReal, 5._pReal/2._pReal, -70.0_pReal/27.0_pReal, 35.0_pReal/27.0_pReal, .0_pReal, &
- 1631._pReal/55296._pReal,175._pReal/512._pReal,575._pReal/13824._pReal,44275._pReal/110592._pReal,253._pReal/4096._pReal],&
+ 1._pREAL/5._pREAL, .0_pREAL, .0_pREAL, .0_pREAL, .0_pREAL, &
+ 3._pREAL/40._pREAL, 9._pREAL/40._pREAL, .0_pREAL, .0_pREAL, .0_pREAL, &
+ 3_pREAL/10._pREAL, -9._pREAL/10._pREAL, 6._pREAL/5._pREAL, .0_pREAL, .0_pREAL, &
+ -11._pREAL/54._pREAL, 5._pREAL/2._pREAL, -70.0_pREAL/27.0_pREAL, 35.0_pREAL/27.0_pREAL, .0_pREAL, &
+ 1631._pREAL/55296._pREAL,175._pREAL/512._pREAL,575._pREAL/13824._pREAL,44275._pREAL/110592._pREAL,253._pREAL/4096._pREAL],&
shape(A))
- real(pReal), dimension(5), parameter :: &
- C = [0.2_pReal, 0.3_pReal, 0.6_pReal, 1.0_pReal, 0.875_pReal]
- real(pReal), dimension(6), parameter :: &
+ real(pREAL), dimension(5), parameter :: &
+ C = [0.2_pREAL, 0.3_pREAL, 0.6_pREAL, 1.0_pREAL, 0.875_pREAL]
+ real(pREAL), dimension(6), parameter :: &
B = &
- [37.0_pReal/378.0_pReal, .0_pReal, 250.0_pReal/621.0_pReal, &
- 125.0_pReal/594.0_pReal, .0_pReal, 512.0_pReal/1771.0_pReal], &
+ [37.0_pREAL/378.0_pREAL, .0_pREAL, 250.0_pREAL/621.0_pREAL, &
+ 125.0_pREAL/594.0_pREAL, .0_pREAL, 512.0_pREAL/1771.0_pREAL], &
DB = B - &
- [2825.0_pReal/27648.0_pReal, .0_pReal, 18575.0_pReal/48384.0_pReal,&
- 13525.0_pReal/55296.0_pReal, 277.0_pReal/14336.0_pReal, 1._pReal/4._pReal]
+ [2825.0_pREAL/27648.0_pREAL, .0_pREAL, 18575.0_pREAL/48384.0_pREAL,&
+ 13525.0_pREAL/55296.0_pREAL, 277.0_pREAL/14336.0_pREAL, 1._pREAL/4._pREAL]
broken = integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en,A,B,C,DB)
@@ -807,12 +807,12 @@ end function integrateStateRKCK45
!--------------------------------------------------------------------------------------------------
function integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en,A,B,C,DB) result(broken)
- real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
- real(pReal), intent(in),dimension(:) :: subState0
- real(pReal), intent(in) :: Delta_t
- real(pReal), dimension(:,:), intent(in) :: A
- real(pReal), dimension(:), intent(in) :: B, C
- real(pReal), dimension(:), intent(in), optional :: DB
+ real(pREAL), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0
+ real(pREAL), intent(in),dimension(:) :: subState0
+ real(pREAL), intent(in) :: Delta_t
+ real(pREAL), dimension(:,:), intent(in) :: A
+ real(pREAL), dimension(:), intent(in) :: B, C
+ real(pREAL), dimension(:), intent(in), optional :: DB
integer, intent(in) :: &
ph, &
en
@@ -822,9 +822,9 @@ function integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,ph,en,A,B,C,DB)
stage, & ! stage index in integration stage loop
n, &
sizeDotState
- real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+ real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
dotState
- real(pReal), dimension(plasticState(ph)%sizeDotState,size(B)) :: &
+ real(pREAL), dimension(plasticState(ph)%sizeDotState,size(B)) :: &
plastic_RKdotState
@@ -945,7 +945,7 @@ subroutine results(group,ph)
function to_quaternion(dataset)
type(tRotation), dimension(:), intent(in) :: dataset
- real(pReal), dimension(4,size(dataset,1)) :: to_quaternion
+ real(pREAL), dimension(4,size(dataset,1)) :: to_quaternion
integer :: i
@@ -986,26 +986,26 @@ end subroutine mechanical_forward
!--------------------------------------------------------------------------------------------------
module function phase_mechanical_constitutive(Delta_t,co,ce) result(converged_)
- real(pReal), intent(in) :: Delta_t
+ real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: &
co, &
ce
logical :: converged_
- real(pReal) :: &
+ real(pREAL) :: &
formerSubStep
integer :: &
ph, en, sizeDotState
logical :: todo
- real(pReal) :: subFrac,subStep
- real(pReal), dimension(3,3) :: &
+ real(pREAL) :: subFrac,subStep
+ real(pREAL), dimension(3,3) :: &
subFp0, &
subFi0, &
subLp0, &
subLi0, &
subF0, &
subF
- real(pReal), dimension(plasticState(material_ID_phase(co,ce))%sizeState) :: subState0
+ real(pREAL), dimension(plasticState(material_ID_phase(co,ce))%sizeState) :: subState0
ph = material_ID_phase(co,ce)
@@ -1017,9 +1017,9 @@ module function phase_mechanical_constitutive(Delta_t,co,ce) result(converged_)
subFp0 = phase_mechanical_Fp0(ph)%data(1:3,1:3,en)
subFi0 = phase_mechanical_Fi0(ph)%data(1:3,1:3,en)
subF0 = phase_mechanical_F0(ph)%data(1:3,1:3,en)
- subFrac = 0.0_pReal
+ subFrac = 0.0_pREAL
todo = .true.
- subStep = 1.0_pReal/num%subStepSizeCryst
+ subStep = 1.0_pREAL/num%subStepSizeCryst
converged_ = .false. ! pretend failed step of 1/subStepSizeCryst
todo = .true.
@@ -1028,9 +1028,9 @@ module function phase_mechanical_constitutive(Delta_t,co,ce) result(converged_)
if (converged_) then
formerSubStep = subStep
subFrac = subFrac + subStep
- subStep = min(1.0_pReal - subFrac, num%stepIncreaseCryst * subStep)
+ subStep = min(1.0_pREAL - subFrac, num%stepIncreaseCryst * subStep)
- todo = subStep > 0.0_pReal ! still time left to integrate on?
+ todo = subStep > 0.0_pREAL ! still time left to integrate on?
if (todo) then
subF0 = subF
@@ -1047,7 +1047,7 @@ module function phase_mechanical_constitutive(Delta_t,co,ce) result(converged_)
phase_mechanical_Fp(ph)%data(1:3,1:3,en) = subFp0
phase_mechanical_Fi(ph)%data(1:3,1:3,en) = subFi0
phase_mechanical_S(ph)%data(1:3,1:3,en) = phase_mechanical_S0(ph)%data(1:3,1:3,en)
- if (subStep < 1.0_pReal) then ! actual (not initial) cutback
+ if (subStep < 1.0_pREAL) then ! actual (not initial) cutback
phase_mechanical_Lp(ph)%data(1:3,1:3,en) = subLp0
phase_mechanical_Li(ph)%data(1:3,1:3,en) = subLi0
end if
@@ -1105,19 +1105,19 @@ end subroutine mechanical_restore
!--------------------------------------------------------------------------------------------------
module function phase_mechanical_dPdF(Delta_t,co,ce) result(dPdF)
- real(pReal), intent(in) :: Delta_t
+ real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: &
co, & !< counter in constituent loop
ce
- real(pReal), dimension(3,3,3,3) :: dPdF
+ real(pREAL), dimension(3,3,3,3) :: dPdF
integer :: &
o, &
p, ph, en
- real(pReal), dimension(3,3) :: devNull, &
+ real(pREAL), dimension(3,3) :: devNull, &
invSubFp0,invSubFi0,invFp,invFi, &
temp_33_1, temp_33_2, temp_33_3
- real(pReal), dimension(3,3,3,3) :: dSdFe, &
+ real(pREAL), dimension(3,3,3,3) :: dSdFe, &
dSdF, &
dSdFi, &
dLidS, & ! tangent in lattice configuration
@@ -1129,7 +1129,7 @@ module function phase_mechanical_dPdF(Delta_t,co,ce) result(dPdF)
rhs_3333, &
lhs_3333, &
temp_3333
- real(pReal), dimension(9,9):: temp_99
+ real(pREAL), dimension(9,9):: temp_99
logical :: error
@@ -1150,9 +1150,9 @@ module function phase_mechanical_dPdF(Delta_t,co,ce) result(dPdF)
invSubFi0 = math_inv33(phase_mechanical_Fi0(ph)%data(1:3,1:3,en))
if (sum(abs(dLidS)) < tol_math_check) then
- dFidS = 0.0_pReal
+ dFidS = 0.0_pREAL
else
- lhs_3333 = 0.0_pReal; rhs_3333 = 0.0_pReal
+ lhs_3333 = 0.0_pREAL; rhs_3333 = 0.0_pREAL
do o=1,3; do p=1,3
#ifndef __INTEL_LLVM_COMPILER
lhs_3333(1:3,1:3,o,p) = lhs_3333(1:3,1:3,o,p) &
@@ -1171,7 +1171,7 @@ module function phase_mechanical_dPdF(Delta_t,co,ce) result(dPdF)
if (error) then
call IO_warning(600,'inversion error in analytic tangent calculation', &
label1='phase',ID1=ph,label2='entry',ID2=en)
- dFidS = 0.0_pReal
+ dFidS = 0.0_pREAL
else
dFidS = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333)
end if
@@ -1223,7 +1223,7 @@ module function phase_mechanical_dPdF(Delta_t,co,ce) result(dPdF)
temp_33_2 = matmul(phase_mechanical_F(ph)%data(1:3,1:3,en),invFp)
temp_33_3 = matmul(temp_33_2,phase_mechanical_S(ph)%data(1:3,1:3,en))
- dPdF = 0.0_pReal
+ dPdF = 0.0_pREAL
do p=1,3
dPdF(p,1:3,p,1:3) = transpose(matmul(invFp,temp_33_1))
end do
@@ -1283,7 +1283,7 @@ end subroutine mechanical_restartRead
module function mechanical_S(ph,en) result(S)
integer, intent(in) :: ph,en
- real(pReal), dimension(3,3) :: S
+ real(pREAL), dimension(3,3) :: S
S = phase_mechanical_S(ph)%data(1:3,1:3,en)
@@ -1297,7 +1297,7 @@ end function mechanical_S
module function mechanical_L_p(ph,en) result(L_p)
integer, intent(in) :: ph,en
- real(pReal), dimension(3,3) :: L_p
+ real(pREAL), dimension(3,3) :: L_p
L_p = phase_mechanical_Lp(ph)%data(1:3,1:3,en)
@@ -1311,7 +1311,7 @@ end function mechanical_L_p
module function mechanical_F_e(ph,en) result(F_e)
integer, intent(in) :: ph,en
- real(pReal), dimension(3,3) :: F_e
+ real(pREAL), dimension(3,3) :: F_e
F_e = phase_mechanical_Fe(ph)%data(1:3,1:3,en)
@@ -1325,7 +1325,7 @@ end function mechanical_F_e
module function mechanical_F_i(ph,en) result(F_i)
integer, intent(in) :: ph,en
- real(pReal), dimension(3,3) :: F_i
+ real(pREAL), dimension(3,3) :: F_i
F_i = phase_mechanical_Fi(ph)%data(1:3,1:3,en)
@@ -1339,7 +1339,7 @@ end function mechanical_F_i
module function phase_P(co,ce) result(P)
integer, intent(in) :: co, ce
- real(pReal), dimension(3,3) :: P
+ real(pREAL), dimension(3,3) :: P
P = phase_mechanical_P(material_ID_phase(co,ce))%data(1:3,1:3,material_entry_phase(co,ce))
@@ -1353,7 +1353,7 @@ end function phase_P
module function phase_F(co,ce) result(F)
integer, intent(in) :: co, ce
- real(pReal), dimension(3,3) :: F
+ real(pREAL), dimension(3,3) :: F
F = phase_mechanical_F(material_ID_phase(co,ce))%data(1:3,1:3,material_entry_phase(co,ce))
@@ -1366,7 +1366,7 @@ end function phase_F
!--------------------------------------------------------------------------------------------------
module subroutine phase_set_F(F,co,ce)
- real(pReal), dimension(3,3), intent(in) :: F
+ real(pREAL), dimension(3,3), intent(in) :: F
integer, intent(in) :: co, ce
diff --git a/src/phase_mechanical_eigen.f90 b/src/phase_mechanical_eigen.f90
index 6b7a079b0..ec1bcfbbc 100644
--- a/src/phase_mechanical_eigen.f90
+++ b/src/phase_mechanical_eigen.f90
@@ -20,9 +20,9 @@ submodule(phase:mechanical) eigen
module subroutine thermalexpansion_LiAndItsTangent(Li, dLi_dTstar, ph,me)
integer, intent(in) :: ph, me
- real(pReal), intent(out), dimension(3,3) :: &
+ real(pREAL), intent(out), dimension(3,3) :: &
Li !< thermal velocity gradient
- real(pReal), intent(out), dimension(3,3,3,3) :: &
+ real(pREAL), intent(out), dimension(3,3,3,3) :: &
dLi_dTstar !< derivative of Li with respect to Tstar (4th-order tensor defined to be zero)
end subroutine thermalexpansion_LiAndItsTangent
@@ -101,7 +101,7 @@ function kinematics_active(kinematics_label,kinematics_length) result(active_ki
kinematics => mechanics%get_list('eigen',defaultVal=emptyList)
do k = 1, kinematics%length
kinematic => kinematics%get_dict(k)
- active_kinematics(k,ph) = kinematic%get_asString('type') == kinematics_label
+ active_kinematics(k,ph) = kinematic%get_asStr('type') == kinematics_label
end do
end do
@@ -129,7 +129,7 @@ function kinematics_active2(kinematics_label) result(active_kinematics)
do ph = 1, phases%length
phase => phases%get_dict(ph)
kinematics_type => phase%get_dict('damage',defaultVal=emptyDict)
- active_kinematics(ph) = kinematics_type%get_asString('type',defaultVal='n/a') == kinematics_label
+ active_kinematics(ph) = kinematics_type%get_asStr('type',defaultVal='n/a') == kinematics_label
end do
@@ -145,32 +145,32 @@ module subroutine phase_LiAndItsTangents(Li, dLi_dS, dLi_dFi, &
integer, intent(in) :: &
ph,en
- real(pReal), intent(in), dimension(3,3) :: &
+ real(pREAL), intent(in), dimension(3,3) :: &
S !< 2nd Piola-Kirchhoff stress
- real(pReal), intent(in), dimension(3,3) :: &
+ real(pREAL), intent(in), dimension(3,3) :: &
Fi !< intermediate deformation gradient
- real(pReal), intent(out), dimension(3,3) :: &
+ real(pREAL), intent(out), dimension(3,3) :: &
Li !< intermediate velocity gradient
- real(pReal), intent(out), dimension(3,3,3,3) :: &
+ real(pREAL), intent(out), dimension(3,3,3,3) :: &
dLi_dS, & !< derivative of Li with respect to S
dLi_dFi
- real(pReal), dimension(3,3) :: &
+ real(pREAL), dimension(3,3) :: &
my_Li, & !< intermediate velocity gradient
FiInv, &
temp_33
- real(pReal), dimension(3,3,3,3) :: &
+ real(pREAL), dimension(3,3,3,3) :: &
my_dLi_dS
- real(pReal) :: &
+ real(pREAL) :: &
detFi
integer :: &
k, i, j
logical :: active
active = .false.
- Li = 0.0_pReal
- dLi_dS = 0.0_pReal
- dLi_dFi = 0.0_pReal
+ Li = 0.0_pREAL
+ dLi_dS = 0.0_pREAL
+ dLi_dFi = 0.0_pREAL
plasticType: select case (phase_plasticity(ph))
diff --git a/src/phase_mechanical_eigen_thermalexpansion.f90 b/src/phase_mechanical_eigen_thermalexpansion.f90
index 23c6b0aee..75a2ae0d0 100644
--- a/src/phase_mechanical_eigen_thermalexpansion.f90
+++ b/src/phase_mechanical_eigen_thermalexpansion.f90
@@ -75,13 +75,13 @@ end function thermalexpansion_init
module subroutine thermalexpansion_LiAndItsTangent(Li, dLi_dTstar, ph,me)
integer, intent(in) :: ph, me
- real(pReal), intent(out), dimension(3,3) :: &
+ real(pREAL), intent(out), dimension(3,3) :: &
Li !< thermal velocity gradient
- real(pReal), intent(out), dimension(3,3,3,3) :: &
+ real(pREAL), intent(out), dimension(3,3,3,3) :: &
dLi_dTstar !< derivative of Li with respect to Tstar (4th-order tensor defined to be zero)
- real(pReal) :: T, dot_T
- real(pReal), dimension(3,3) :: Alpha
+ real(pREAL) :: T, dot_T
+ real(pREAL), dimension(3,3) :: Alpha
T = thermal_T(ph,me)
@@ -89,14 +89,14 @@ module subroutine thermalexpansion_LiAndItsTangent(Li, dLi_dTstar, ph,me)
associate(prm => param(kinematics_thermal_expansion_instance(ph)))
- Alpha = 0.0_pReal
+ Alpha = 0.0_pREAL
Alpha(1,1) = prm%Alpha_11%at(T)
if (any(phase_lattice(ph) == ['hP','tI'])) Alpha(3,3) = prm%Alpha_33%at(T)
Alpha = lattice_symmetrize_33(Alpha,phase_lattice(ph))
Li = dot_T * Alpha
end associate
- dLi_dTstar = 0.0_pReal
+ dLi_dTstar = 0.0_pREAL
end subroutine thermalexpansion_LiAndItsTangent
diff --git a/src/phase_mechanical_elastic.f90 b/src/phase_mechanical_elastic.f90
index 15a5d29c2..75a8753a5 100644
--- a/src/phase_mechanical_elastic.f90
+++ b/src/phase_mechanical_elastic.f90
@@ -46,7 +46,7 @@ module subroutine elastic_init(phases)
print'(/,1x,a,i0,a)', 'phase ',ph,': '//phases%key(ph)
refs = config_listReferences(elastic,indent=3)
if (len(refs) > 0) print'(/,1x,a)', refs
- if (elastic%get_asString('type') /= 'Hooke') call IO_error(200,ext_msg=elastic%get_asString('type'))
+ if (elastic%get_asStr('type') /= 'Hooke') call IO_error(200,ext_msg=elastic%get_asStr('type'))
associate(prm => param(ph))
@@ -77,13 +77,13 @@ pure module function elastic_C66(ph,en) result(C66)
ph, &
en
- real(pReal), dimension(6,6) :: C66
- real(pReal) :: T
+ real(pREAL), dimension(6,6) :: C66
+ real(pREAL) :: T
associate(prm => param(ph))
- C66 = 0.0_pReal
+ C66 = 0.0_pREAL
T = thermal_T(ph,en)
C66(1,1) = prm%C_11%at(T)
@@ -113,7 +113,7 @@ pure module function elastic_mu(ph,en,isotropic_bound) result(mu)
ph, &
en
character(len=*), intent(in) :: isotropic_bound
- real(pReal) :: &
+ real(pREAL) :: &
mu
@@ -135,7 +135,7 @@ pure module function elastic_nu(ph,en,isotropic_bound) result(nu)
ph, &
en
character(len=*), intent(in) :: isotropic_bound
- real(pReal) :: &
+ real(pREAL) :: &
nu
@@ -160,18 +160,18 @@ module subroutine phase_hooke_SandItsTangents(S, dS_dFe, dS_dFi, &
integer, intent(in) :: &
ph, &
en
- real(pReal), intent(in), dimension(3,3) :: &
+ real(pREAL), intent(in), dimension(3,3) :: &
Fe, & !< elastic deformation gradient
Fi !< intermediate deformation gradient
- real(pReal), intent(out), dimension(3,3) :: &
+ real(pREAL), intent(out), dimension(3,3) :: &
S !< 2nd Piola-Kirchhoff stress tensor in lattice configuration
- real(pReal), intent(out), dimension(3,3,3,3) :: &
+ real(pREAL), intent(out), dimension(3,3,3,3) :: &
dS_dFe, & !< derivative of 2nd P-K stress with respect to elastic deformation gradient
dS_dFi !< derivative of 2nd P-K stress with respect to intermediate deformation gradient
- real(pReal), dimension(3,3) :: E
- real(pReal), dimension(6,6) :: C66
- real(pReal), dimension(3,3,3,3) :: C
+ real(pREAL), dimension(3,3) :: E
+ real(pREAL), dimension(6,6) :: C66
+ real(pREAL), dimension(3,3,3,3) :: C
integer :: &
i, j
@@ -179,12 +179,12 @@ module subroutine phase_hooke_SandItsTangents(S, dS_dFe, dS_dFi, &
C66 = phase_damage_C66(phase_homogenizedC66(ph,en),ph,en)
C = math_Voigt66to3333_stiffness(C66)
- E = 0.5_pReal*(matmul(transpose(Fe),Fe)-math_I3) !< Green-Lagrange strain in unloaded configuration
+ E = 0.5_pREAL*(matmul(transpose(Fe),Fe)-math_I3) !< Green-Lagrange strain in unloaded configuration
S = math_Voigt6to33_stress(matmul(C66,math_33toVoigt6_strain(matmul(matmul(transpose(Fi),E),Fi))))!< 2PK stress in lattice configuration in work conjugate with GL strain pulled back to lattice configuration
do i =1,3; do j=1,3
dS_dFe(i,j,1:3,1:3) = matmul(Fe,matmul(matmul(Fi,C(i,j,1:3,1:3)),transpose(Fi))) !< dS_ij/dFe_kl = C_ijmn * Fi_lm * Fi_on * Fe_ko
- dS_dFi(i,j,1:3,1:3) = 2.0_pReal*matmul(matmul(E,Fi),C(i,j,1:3,1:3)) !< dS_ij/dFi_kl = C_ijln * E_km * Fe_mn
+ dS_dFi(i,j,1:3,1:3) = 2.0_pREAL*matmul(matmul(E,Fi),C(i,j,1:3,1:3)) !< dS_ij/dFi_kl = C_ijln * E_km * Fe_mn
end do; end do
end subroutine phase_hooke_SandItsTangents
@@ -195,7 +195,7 @@ end subroutine phase_hooke_SandItsTangents
!--------------------------------------------------------------------------------------------------
module function phase_homogenizedC66(ph,en) result(C)
- real(pReal), dimension(6,6) :: C
+ real(pREAL), dimension(6,6) :: C
integer, intent(in) :: ph, en
diff --git a/src/phase_mechanical_plastic.f90 b/src/phase_mechanical_plastic.f90
index 4140e0805..0c1959660 100644
--- a/src/phase_mechanical_plastic.f90
+++ b/src/phase_mechanical_plastic.f90
@@ -38,11 +38,11 @@ submodule(phase:mechanical) plastic
end function plastic_nonlocal_init
module subroutine isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
- real(pReal), dimension(3,3), intent(out) :: &
+ real(pREAL), dimension(3,3), intent(out) :: &
Lp
- real(pReal), dimension(3,3,3,3), intent(out) :: &
+ real(pREAL), dimension(3,3,3,3), intent(out) :: &
dLp_dMp
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp
integer, intent(in) :: &
ph, &
@@ -50,11 +50,11 @@ submodule(phase:mechanical) plastic
end subroutine isotropic_LpAndItsTangent
pure module subroutine phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
- real(pReal), dimension(3,3), intent(out) :: &
+ real(pREAL), dimension(3,3), intent(out) :: &
Lp
- real(pReal), dimension(3,3,3,3), intent(out) :: &
+ real(pREAL), dimension(3,3,3,3), intent(out) :: &
dLp_dMp
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp
integer, intent(in) :: &
ph, &
@@ -62,11 +62,11 @@ submodule(phase:mechanical) plastic
end subroutine phenopowerlaw_LpAndItsTangent
pure module subroutine kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
- real(pReal), dimension(3,3), intent(out) :: &
+ real(pREAL), dimension(3,3), intent(out) :: &
Lp
- real(pReal), dimension(3,3,3,3), intent(out) :: &
+ real(pREAL), dimension(3,3,3,3), intent(out) :: &
dLp_dMp
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp
integer, intent(in) :: &
ph, &
@@ -74,11 +74,11 @@ submodule(phase:mechanical) plastic
end subroutine kinehardening_LpAndItsTangent
module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
- real(pReal), dimension(3,3), intent(out) :: &
+ real(pREAL), dimension(3,3), intent(out) :: &
Lp
- real(pReal), dimension(3,3,3,3), intent(out) :: &
+ real(pREAL), dimension(3,3,3,3), intent(out) :: &
dLp_dMp
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp
integer, intent(in) :: &
ph, &
@@ -86,11 +86,11 @@ submodule(phase:mechanical) plastic
end subroutine dislotwin_LpAndItsTangent
pure module subroutine dislotungsten_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
- real(pReal), dimension(3,3), intent(out) :: &
+ real(pREAL), dimension(3,3), intent(out) :: &
Lp
- real(pReal), dimension(3,3,3,3), intent(out) :: &
+ real(pREAL), dimension(3,3,3,3), intent(out) :: &
dLp_dMp
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp
integer, intent(in) :: &
ph, &
@@ -98,11 +98,11 @@ submodule(phase:mechanical) plastic
end subroutine dislotungsten_LpAndItsTangent
module subroutine nonlocal_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
- real(pReal), dimension(3,3), intent(out) :: &
+ real(pREAL), dimension(3,3), intent(out) :: &
Lp
- real(pReal), dimension(3,3,3,3), intent(out) :: &
+ real(pREAL), dimension(3,3,3,3), intent(out) :: &
dLp_dMp
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer, intent(in) :: &
ph, &
@@ -111,59 +111,59 @@ submodule(phase:mechanical) plastic
module function isotropic_dotState(Mp,ph,en) result(dotState)
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer, intent(in) :: &
ph, &
en
- real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+ real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
dotState
end function isotropic_dotState
module function phenopowerlaw_dotState(Mp,ph,en) result(dotState)
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer, intent(in) :: &
ph, &
en
- real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+ real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
dotState
end function phenopowerlaw_dotState
module function plastic_kinehardening_dotState(Mp,ph,en) result(dotState)
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer, intent(in) :: &
ph, &
en
- real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+ real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
dotState
end function plastic_kinehardening_dotState
module function dislotwin_dotState(Mp,ph,en) result(dotState)
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer, intent(in) :: &
ph, &
en
- real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+ real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
dotState
end function dislotwin_dotState
module function dislotungsten_dotState(Mp,ph,en) result(dotState)
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer, intent(in) :: &
ph, &
en
- real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+ real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
dotState
end function dislotungsten_dotState
module subroutine nonlocal_dotState(Mp,timestep,ph,en)
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp !< MandelStress
- real(pReal), intent(in) :: &
+ real(pREAL), intent(in) :: &
timestep !< substepped crystallite time increment
integer, intent(in) :: &
ph, &
@@ -189,7 +189,7 @@ submodule(phase:mechanical) plastic
end subroutine nonlocal_dependentState
module subroutine plastic_kinehardening_deltaState(Mp,ph,en)
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer, intent(in) :: &
ph, &
@@ -197,7 +197,7 @@ submodule(phase:mechanical) plastic
end subroutine plastic_kinehardening_deltaState
module subroutine plastic_nonlocal_deltaState(Mp,ph,en)
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp
integer, intent(in) :: &
ph, &
@@ -234,27 +234,27 @@ module subroutine plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, &
S, Fi, ph,en)
integer, intent(in) :: &
ph,en
- real(pReal), intent(in), dimension(3,3) :: &
+ real(pREAL), intent(in), dimension(3,3) :: &
S, & !< 2nd Piola-Kirchhoff stress
Fi !< intermediate deformation gradient
- real(pReal), intent(out), dimension(3,3) :: &
+ real(pREAL), intent(out), dimension(3,3) :: &
Lp !< plastic velocity gradient
- real(pReal), intent(out), dimension(3,3,3,3) :: &
+ real(pREAL), intent(out), dimension(3,3,3,3) :: &
dLp_dS, &
dLp_dFi !< derivative en Lp with respect to Fi
- real(pReal), dimension(3,3,3,3) :: &
+ real(pREAL), dimension(3,3,3,3) :: &
dLp_dMp !< derivative of Lp with respect to Mandel stress
- real(pReal), dimension(3,3) :: &
+ real(pREAL), dimension(3,3) :: &
Mp !< Mandel stress work conjugate with Lp
integer :: &
i, j
if (phase_plasticity(ph) == PLASTIC_NONE_ID) then
- Lp = 0.0_pReal
- dLp_dFi = 0.0_pReal
- dLp_dS = 0.0_pReal
+ Lp = 0.0_pREAL
+ dLp_dFi = 0.0_pREAL
+ dLp_dS = 0.0_pREAL
else
Mp = matmul(matmul(transpose(Fi),Fi),S)
@@ -300,11 +300,11 @@ module function plastic_dotState(subdt,ph,en) result(dotState)
integer, intent(in) :: &
ph, &
en
- real(pReal), intent(in) :: &
+ real(pREAL), intent(in) :: &
subdt !< timestep
- real(pReal), dimension(3,3) :: &
+ real(pREAL), dimension(3,3) :: &
Mp
- real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+ real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
dotState
@@ -376,7 +376,7 @@ module function plastic_deltaState(ph, en) result(broken)
en
logical :: broken
- real(pReal), dimension(3,3) :: &
+ real(pREAL), dimension(3,3) :: &
Mp
integer :: &
mySize
@@ -434,7 +434,7 @@ function plastic_active(plastic_label) result(active_plastic)
phase => phases%get_dict(ph)
mech => phase%get_dict('mechanical')
pl => mech%get_dict('plastic',defaultVal = emptyDict)
- active_plastic(ph) = pl%get_asString('type',defaultVal='none') == plastic_label
+ active_plastic(ph) = pl%get_asStr('type',defaultVal='none') == plastic_label
end do
end function plastic_active
diff --git a/src/phase_mechanical_plastic_dislotungsten.f90 b/src/phase_mechanical_plastic_dislotungsten.f90
index e37511967..846551989 100644
--- a/src/phase_mechanical_plastic_dislotungsten.f90
+++ b/src/phase_mechanical_plastic_dislotungsten.f90
@@ -8,11 +8,11 @@
submodule(phase:plastic) dislotungsten
type :: tParameters
- real(pReal) :: &
- D = 1.0_pReal, & !< grain size
- D_0 = 1.0_pReal, & !< prefactor for self-diffusion coefficient
- Q_cl = 1.0_pReal !< activation energy for dislocation climb
- real(pReal), allocatable, dimension(:) :: &
+ real(pREAL) :: &
+ D = 1.0_pREAL, & !< grain size
+ D_0 = 1.0_pREAL, & !< prefactor for self-diffusion coefficient
+ Q_cl = 1.0_pREAL !< activation energy for dislocation climb
+ real(pREAL), allocatable, dimension(:) :: &
b_sl, & !< magnitude of Burgers vector [m]
d_caron, & !< distance of spontaneous annhihilation
i_sl, & !< Adj. parameter for distance between 2 forest dislocations
@@ -26,10 +26,10 @@ submodule(phase:plastic) dislotungsten
h, & !< height of the kink pair
w, & !< width of the kink pair
omega !< attempt frequency for kink pair nucleation
- real(pReal), allocatable, dimension(:,:) :: &
+ real(pREAL), allocatable, dimension(:,:) :: &
h_sl_sl, & !< slip resistance from slip activity
forestProjection
- real(pReal), allocatable, dimension(:,:,:) :: &
+ real(pREAL), allocatable, dimension(:,:,:) :: &
P_sl, &
P_nS_pos, &
P_nS_neg
@@ -37,7 +37,7 @@ submodule(phase:plastic) dislotungsten
sum_N_sl !< total number of active slip system
character(len=:), allocatable :: &
isotropic_bound
- character(len=pStringLen), allocatable, dimension(:) :: &
+ character(len=pSTRLEN), allocatable, dimension(:) :: &
output
logical :: &
dipoleFormation !< flag indicating consideration of dipole formation
@@ -53,14 +53,14 @@ submodule(phase:plastic) dislotungsten
end type tIndexDotState
type :: tDislotungstenState
- real(pReal), dimension(:,:), pointer :: &
+ real(pREAL), dimension(:,:), pointer :: &
rho_mob, &
rho_dip, &
gamma_sl
end type tDislotungstenState
type :: tDislotungstenDependentState
- real(pReal), dimension(:,:), allocatable :: &
+ real(pREAL), dimension(:,:), allocatable :: &
Lambda_sl, &
tau_pass
end type tDislotungstenDependentState
@@ -89,7 +89,7 @@ module function plastic_dislotungsten_init() result(myPlasticity)
startIndex, endIndex
integer, dimension(:), allocatable :: &
N_sl
- real(pReal),dimension(:), allocatable :: &
+ real(pREAL),dimension(:), allocatable :: &
rho_mob_0, & !< initial dislocation density
rho_dip_0, & !< initial dipole density
a !< non-Schmid coefficients
@@ -135,12 +135,12 @@ module function plastic_dislotungsten_init() result(myPlasticity)
if (len(refs) > 0) print'(/,1x,a)', refs
#if defined (__GFORTRAN__)
- prm%output = output_as1dString(pl)
+ prm%output = output_as1dStr(pl)
#else
- prm%output = pl%get_as1dString('output',defaultVal=emptyStringArray)
+ prm%output = pl%get_as1dStr('output',defaultVal=emptyStrArray)
#endif
- prm%isotropic_bound = pl%get_asString('isotropic_bound',defaultVal='isostrain')
+ prm%isotropic_bound = pl%get_asStr('isotropic_bound',defaultVal='isostrain')
!--------------------------------------------------------------------------------------------------
! slip related parameters
@@ -151,7 +151,7 @@ module function plastic_dislotungsten_init() result(myPlasticity)
prm%P_sl = lattice_SchmidMatrix_slip(N_sl,phase_lattice(ph),phase_cOverA(ph))
if (phase_lattice(ph) == 'cI') then
- a = pl%get_as1dFloat('a_nonSchmid',defaultVal = emptyRealArray)
+ a = pl%get_as1dReal('a_nonSchmid',defaultVal = emptyRealArray)
prm%P_nS_pos = lattice_nonSchmidMatrix(N_sl,a,+1)
prm%P_nS_neg = lattice_nonSchmidMatrix(N_sl,a,-1)
else
@@ -159,30 +159,30 @@ module function plastic_dislotungsten_init() result(myPlasticity)
prm%P_nS_neg = prm%P_sl
end if
- prm%h_sl_sl = lattice_interaction_SlipBySlip(N_sl,pl%get_as1dFloat('h_sl-sl'), &
+ prm%h_sl_sl = lattice_interaction_SlipBySlip(N_sl,pl%get_as1dReal('h_sl-sl'), &
phase_lattice(ph))
prm%forestProjection = lattice_forestProjection_edge(N_sl,phase_lattice(ph),&
phase_cOverA(ph))
prm%forestProjection = transpose(prm%forestProjection)
- rho_mob_0 = pl%get_as1dFloat('rho_mob_0', requiredSize=size(N_sl))
- rho_dip_0 = pl%get_as1dFloat('rho_dip_0', requiredSize=size(N_sl))
- prm%b_sl = pl%get_as1dFloat('b_sl', requiredSize=size(N_sl))
- prm%Q_s = pl%get_as1dFloat('Q_s', requiredSize=size(N_sl))
+ rho_mob_0 = pl%get_as1dReal('rho_mob_0', requiredSize=size(N_sl))
+ rho_dip_0 = pl%get_as1dReal('rho_dip_0', requiredSize=size(N_sl))
+ prm%b_sl = pl%get_as1dReal('b_sl', requiredSize=size(N_sl))
+ prm%Q_s = pl%get_as1dReal('Q_s', requiredSize=size(N_sl))
- prm%i_sl = pl%get_as1dFloat('i_sl', requiredSize=size(N_sl))
- prm%tau_Peierls = pl%get_as1dFloat('tau_Peierls', requiredSize=size(N_sl))
- prm%p = pl%get_as1dFloat('p_sl', requiredSize=size(N_sl))
- prm%q = pl%get_as1dFloat('q_sl', requiredSize=size(N_sl))
- prm%h = pl%get_as1dFloat('h', requiredSize=size(N_sl))
- prm%w = pl%get_as1dFloat('w', requiredSize=size(N_sl))
- prm%omega = pl%get_as1dFloat('omega', requiredSize=size(N_sl))
- prm%B = pl%get_as1dFloat('B', requiredSize=size(N_sl))
+ prm%i_sl = pl%get_as1dReal('i_sl', requiredSize=size(N_sl))
+ prm%tau_Peierls = pl%get_as1dReal('tau_Peierls', requiredSize=size(N_sl))
+ prm%p = pl%get_as1dReal('p_sl', requiredSize=size(N_sl))
+ prm%q = pl%get_as1dReal('q_sl', requiredSize=size(N_sl))
+ prm%h = pl%get_as1dReal('h', requiredSize=size(N_sl))
+ prm%w = pl%get_as1dReal('w', requiredSize=size(N_sl))
+ prm%omega = pl%get_as1dReal('omega', requiredSize=size(N_sl))
+ prm%B = pl%get_as1dReal('B', requiredSize=size(N_sl))
- prm%D = pl%get_asFloat('D')
- prm%D_0 = pl%get_asFloat('D_0')
- prm%Q_cl = pl%get_asFloat('Q_cl')
- prm%f_at = pl%get_asFloat('f_at') * prm%b_sl**3
+ prm%D = pl%get_asReal('D')
+ prm%D_0 = pl%get_asReal('D_0')
+ prm%Q_cl = pl%get_asReal('Q_cl')
+ prm%f_at = pl%get_asReal('f_at') * prm%b_sl**3
prm%dipoleformation = .not. pl%get_asBool('no_dipole_formation', defaultVal = .false.)
@@ -200,19 +200,19 @@ module function plastic_dislotungsten_init() result(myPlasticity)
prm%B = math_expand(prm%B, N_sl)
prm%i_sl = math_expand(prm%i_sl, N_sl)
prm%f_at = math_expand(prm%f_at, N_sl)
- prm%d_caron = pl%get_asFloat('D_a') * prm%b_sl
+ prm%d_caron = pl%get_asReal('D_a') * prm%b_sl
! sanity checks
- if ( prm%D_0 < 0.0_pReal) extmsg = trim(extmsg)//' D_0'
- if ( prm%Q_cl <= 0.0_pReal) extmsg = trim(extmsg)//' Q_cl'
- if (any(rho_mob_0 < 0.0_pReal)) extmsg = trim(extmsg)//' rho_mob_0'
- if (any(rho_dip_0 < 0.0_pReal)) extmsg = trim(extmsg)//' rho_dip_0'
- if (any(prm%b_sl <= 0.0_pReal)) extmsg = trim(extmsg)//' b_sl'
- if (any(prm%Q_s <= 0.0_pReal)) extmsg = trim(extmsg)//' Q_s'
- if (any(prm%tau_Peierls < 0.0_pReal)) extmsg = trim(extmsg)//' tau_Peierls'
- if (any(prm%B < 0.0_pReal)) extmsg = trim(extmsg)//' B'
- if (any(prm%d_caron < 0.0_pReal)) extmsg = trim(extmsg)//' d_caron(D_a,b_sl)'
- if (any(prm%f_at <= 0.0_pReal)) extmsg = trim(extmsg)//' f_at or b_sl'
+ if ( prm%D_0 < 0.0_pREAL) extmsg = trim(extmsg)//' D_0'
+ if ( prm%Q_cl <= 0.0_pREAL) extmsg = trim(extmsg)//' Q_cl'
+ if (any(rho_mob_0 < 0.0_pREAL)) extmsg = trim(extmsg)//' rho_mob_0'
+ if (any(rho_dip_0 < 0.0_pREAL)) extmsg = trim(extmsg)//' rho_dip_0'
+ if (any(prm%b_sl <= 0.0_pREAL)) extmsg = trim(extmsg)//' b_sl'
+ if (any(prm%Q_s <= 0.0_pREAL)) extmsg = trim(extmsg)//' Q_s'
+ if (any(prm%tau_Peierls < 0.0_pREAL)) extmsg = trim(extmsg)//' tau_Peierls'
+ if (any(prm%B < 0.0_pREAL)) extmsg = trim(extmsg)//' B'
+ if (any(prm%d_caron < 0.0_pREAL)) extmsg = trim(extmsg)//' d_caron(D_a,b_sl)'
+ if (any(prm%f_at <= 0.0_pREAL)) extmsg = trim(extmsg)//' f_at or b_sl'
else slipActive
rho_mob_0 = emptyRealArray; rho_dip_0 = emptyRealArray
@@ -239,25 +239,25 @@ module function plastic_dislotungsten_init() result(myPlasticity)
idx_dot%rho_mob = [startIndex,endIndex]
stt%rho_mob => plasticState(ph)%state(startIndex:endIndex,:)
stt%rho_mob = spread(rho_mob_0,2,Nmembers)
- plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_rho',defaultVal=1.0_pReal)
- if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_rho'
+ plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_rho',defaultVal=1.0_pREAL)
+ if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pREAL)) extmsg = trim(extmsg)//' atol_rho'
startIndex = endIndex + 1
endIndex = endIndex + prm%sum_N_sl
idx_dot%rho_dip = [startIndex,endIndex]
stt%rho_dip => plasticState(ph)%state(startIndex:endIndex,:)
stt%rho_dip = spread(rho_dip_0,2,Nmembers)
- plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_rho',defaultVal=1.0_pReal)
+ plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_rho',defaultVal=1.0_pREAL)
startIndex = endIndex + 1
endIndex = endIndex + prm%sum_N_sl
idx_dot%gamma_sl = [startIndex,endIndex]
stt%gamma_sl => plasticState(ph)%state(startIndex:endIndex,:)
- plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_gamma',defaultVal=1.0e-6_pReal)
- if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_gamma'
+ plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_gamma',defaultVal=1.0e-6_pREAL)
+ if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pREAL)) extmsg = trim(extmsg)//' atol_gamma'
- allocate(dst%Lambda_sl(prm%sum_N_sl,Nmembers), source=0.0_pReal)
- allocate(dst%tau_pass(prm%sum_N_sl,Nmembers), source=0.0_pReal)
+ allocate(dst%Lambda_sl(prm%sum_N_sl,Nmembers), source=0.0_pREAL)
+ allocate(dst%tau_pass(prm%sum_N_sl,Nmembers), source=0.0_pREAL)
end associate
@@ -275,11 +275,11 @@ end function plastic_dislotungsten_init
!--------------------------------------------------------------------------------------------------
pure module subroutine dislotungsten_LpAndItsTangent(Lp,dLp_dMp, &
Mp,ph,en)
- real(pReal), dimension(3,3), intent(out) :: &
+ real(pREAL), dimension(3,3), intent(out) :: &
Lp !< plastic velocity gradient
- real(pReal), dimension(3,3,3,3), intent(out) :: &
+ real(pREAL), dimension(3,3,3,3), intent(out) :: &
dLp_dMp !< derivative of Lp with respect to the Mandel stress
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer, intent(in) :: &
ph, &
@@ -287,16 +287,16 @@ pure module subroutine dislotungsten_LpAndItsTangent(Lp,dLp_dMp, &
integer :: &
i,k,l,m,n
- real(pReal) :: &
+ real(pREAL) :: &
T !< temperature
- real(pReal), dimension(param(ph)%sum_N_sl) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl) :: &
dot_gamma_pos,dot_gamma_neg, &
ddot_gamma_dtau_pos,ddot_gamma_dtau_neg
T = thermal_T(ph,en)
- Lp = 0.0_pReal
- dLp_dMp = 0.0_pReal
+ Lp = 0.0_pREAL
+ dLp_dMp = 0.0_pREAL
associate(prm => param(ph))
@@ -319,15 +319,15 @@ end subroutine dislotungsten_LpAndItsTangent
!--------------------------------------------------------------------------------------------------
module function dislotungsten_dotState(Mp,ph,en) result(dotState)
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer, intent(in) :: &
ph, &
en
- real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+ real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
dotState
- real(pReal), dimension(param(ph)%sum_N_sl) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl) :: &
dot_gamma_pos, dot_gamma_neg,&
tau_pos,&
tau_neg, &
@@ -335,7 +335,7 @@ module function dislotungsten_dotState(Mp,ph,en) result(dotState)
dot_rho_dip_formation, &
dot_rho_dip_climb, &
d_hat
- real(pReal) :: &
+ real(pREAL) :: &
mu, T
@@ -353,26 +353,26 @@ module function dislotungsten_dotState(Mp,ph,en) result(dotState)
dot_gamma_sl = abs(dot_gamma_pos+dot_gamma_neg)
- where(dEq0((tau_pos+tau_neg)*0.5_pReal))
- dot_rho_dip_formation = 0.0_pReal
- dot_rho_dip_climb = 0.0_pReal
+ where(dEq0((tau_pos+tau_neg)*0.5_pREAL))
+ dot_rho_dip_formation = 0.0_pREAL
+ dot_rho_dip_climb = 0.0_pREAL
else where
- d_hat = math_clip(3.0_pReal*mu*prm%b_sl/(16.0_pReal*PI*abs(tau_pos+tau_neg)*0.5_pReal), &
+ d_hat = math_clip(3.0_pREAL*mu*prm%b_sl/(16.0_pREAL*PI*abs(tau_pos+tau_neg)*0.5_pREAL), &
prm%d_caron, & ! lower limit
dst%Lambda_sl(:,en)) ! upper limit
- dot_rho_dip_formation = merge(2.0_pReal*(d_hat-prm%d_caron)*stt%rho_mob(:,en)*dot_gamma_sl/prm%b_sl, &
- 0.0_pReal, &
+ dot_rho_dip_formation = merge(2.0_pREAL*(d_hat-prm%d_caron)*stt%rho_mob(:,en)*dot_gamma_sl/prm%b_sl, &
+ 0.0_pREAL, &
prm%dipoleformation)
- v_cl = (3.0_pReal*mu*prm%D_0*exp(-prm%Q_cl/(K_B*T))*prm%f_at/(TAU*K_B*T)) &
- * (1.0_pReal/(d_hat+prm%d_caron))
- dot_rho_dip_climb = (4.0_pReal*v_cl*stt%rho_dip(:,en))/(d_hat-prm%d_caron) ! ToDo: Discuss with Franz: Stress dependency?
+ v_cl = (3.0_pREAL*mu*prm%D_0*exp(-prm%Q_cl/(K_B*T))*prm%f_at/(TAU*K_B*T)) &
+ * (1.0_pREAL/(d_hat+prm%d_caron))
+ dot_rho_dip_climb = (4.0_pREAL*v_cl*stt%rho_dip(:,en))/(d_hat-prm%d_caron) ! ToDo: Discuss with Franz: Stress dependency?
end where
dot_rho_mob = dot_gamma_sl/(prm%b_sl*dst%Lambda_sl(:,en)) & ! multiplication
- dot_rho_dip_formation &
- - (2.0_pReal*prm%d_caron)/prm%b_sl*stt%rho_mob(:,en)*dot_gamma_sl ! Spontaneous annihilation of 2 edges
+ - (2.0_pREAL*prm%d_caron)/prm%b_sl*stt%rho_mob(:,en)*dot_gamma_sl ! Spontaneous annihilation of 2 edges
dot_rho_dip = dot_rho_dip_formation &
- - (2.0_pReal*prm%d_caron)/prm%b_sl*stt%rho_dip(:,en)*dot_gamma_sl & ! Spontaneous annihilation of an edge with a dipole
+ - (2.0_pREAL*prm%d_caron)/prm%b_sl*stt%rho_dip(:,en)*dot_gamma_sl & ! Spontaneous annihilation of an edge with a dipole
- dot_rho_dip_climb
end associate
@@ -389,7 +389,7 @@ module subroutine dislotungsten_dependentState(ph,en)
ph, &
en
- real(pReal), dimension(param(ph)%sum_N_sl) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl) :: &
Lambda_sl_inv
@@ -398,9 +398,9 @@ module subroutine dislotungsten_dependentState(ph,en)
dst%tau_pass(:,en) = elastic_mu(ph,en,prm%isotropic_bound)*prm%b_sl &
* sqrt(matmul(prm%h_sl_sl,stt%rho_mob(:,en)+stt%rho_dip(:,en)))
- Lambda_sl_inv = 1.0_pReal/prm%D &
+ Lambda_sl_inv = 1.0_pREAL/prm%D &
+ sqrt(matmul(prm%forestProjection,stt%rho_mob(:,en)+stt%rho_dip(:,en)))/prm%i_sl
- dst%Lambda_sl(:,en) = Lambda_sl_inv**(-1.0_pReal)
+ dst%Lambda_sl(:,en) = Lambda_sl_inv**(-1.0_pREAL)
end associate
@@ -458,24 +458,24 @@ end subroutine plastic_dislotungsten_result
pure subroutine kinetics(Mp,T,ph,en, &
dot_gamma_pos,dot_gamma_neg,ddot_gamma_dtau_pos,ddot_gamma_dtau_neg,tau_pos_out,tau_neg_out)
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
- real(pReal), intent(in) :: &
+ real(pREAL), intent(in) :: &
T !< temperature
integer, intent(in) :: &
ph, &
en
- real(pReal), intent(out), dimension(param(ph)%sum_N_sl) :: &
+ real(pREAL), intent(out), dimension(param(ph)%sum_N_sl) :: &
dot_gamma_pos, &
dot_gamma_neg
- real(pReal), intent(out), optional, dimension(param(ph)%sum_N_sl) :: &
+ real(pREAL), intent(out), optional, dimension(param(ph)%sum_N_sl) :: &
ddot_gamma_dtau_pos, &
ddot_gamma_dtau_neg, &
tau_pos_out, &
tau_neg_out
- real(pReal), dimension(param(ph)%sum_N_sl) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl) :: &
StressRatio, &
StressRatio_p,StressRatio_pminus1, &
dvel, &
@@ -495,7 +495,7 @@ pure subroutine kinetics(Mp,T,ph,en, &
if (present(tau_neg_out)) tau_neg_out = tau_neg
associate(BoltzmannRatio => prm%Q_s/(K_B*T), &
- b_rho_half => stt%rho_mob(:,en) * prm%b_sl * 0.5_pReal, &
+ b_rho_half => stt%rho_mob(:,en) * prm%b_sl * 0.5_pREAL, &
effectiveLength => dst%Lambda_sl(:,en) - prm%w)
tau_eff = abs(tau_pos)-dst%tau_pass(:,en)
@@ -503,28 +503,28 @@ pure subroutine kinetics(Mp,T,ph,en, &
significantPositiveTau: where(tau_eff > tol_math_check)
StressRatio = tau_eff/prm%tau_Peierls
StressRatio_p = StressRatio** prm%p
- StressRatio_pminus1 = StressRatio**(prm%p-1.0_pReal)
+ StressRatio_pminus1 = StressRatio**(prm%p-1.0_pREAL)
- t_n = prm%b_sl*exp(BoltzmannRatio*(1.0_pReal-StressRatio_p) ** prm%q) &
+ t_n = prm%b_sl*exp(BoltzmannRatio*(1.0_pREAL-StressRatio_p) ** prm%q) &
/ (prm%omega*effectiveLength)
- t_k = effectiveLength * prm%B /(2.0_pReal*prm%b_sl*tau_eff) ! corrected eq. (14)
+ t_k = effectiveLength * prm%B /(2.0_pREAL*prm%b_sl*tau_eff) ! corrected eq. (14)
dot_gamma_pos = b_rho_half * sign(prm%h/(t_n + t_k),tau_pos)
else where significantPositiveTau
- dot_gamma_pos = 0.0_pReal
+ dot_gamma_pos = 0.0_pREAL
end where significantPositiveTau
if (present(ddot_gamma_dtau_pos)) then
significantPositiveTau2: where(abs(tau_pos)-dst%tau_pass(:,en) > tol_math_check)
- dtn = -1.0_pReal * t_n * BoltzmannRatio * prm%p * prm%q * (1.0_pReal-StressRatio_p)**(prm%q - 1.0_pReal) &
+ dtn = -1.0_pREAL * t_n * BoltzmannRatio * prm%p * prm%q * (1.0_pREAL-StressRatio_p)**(prm%q - 1.0_pREAL) &
* StressRatio_pminus1 / prm%tau_Peierls
- dtk = -1.0_pReal * t_k / tau_pos
+ dtk = -1.0_pREAL * t_k / tau_pos
- dvel = -1.0_pReal * prm%h * (dtk + dtn) / (t_n + t_k)**2
+ dvel = -1.0_pREAL * prm%h * (dtk + dtn) / (t_n + t_k)**2
ddot_gamma_dtau_pos = b_rho_half * dvel
else where significantPositiveTau2
- ddot_gamma_dtau_pos = 0.0_pReal
+ ddot_gamma_dtau_pos = 0.0_pREAL
end where significantPositiveTau2
end if
@@ -533,28 +533,28 @@ pure subroutine kinetics(Mp,T,ph,en, &
significantNegativeTau: where(tau_eff > tol_math_check)
StressRatio = tau_eff/prm%tau_Peierls
StressRatio_p = StressRatio** prm%p
- StressRatio_pminus1 = StressRatio**(prm%p-1.0_pReal)
+ StressRatio_pminus1 = StressRatio**(prm%p-1.0_pREAL)
- t_n = prm%b_sl*exp(BoltzmannRatio*(1.0_pReal-StressRatio_p) ** prm%q) &
+ t_n = prm%b_sl*exp(BoltzmannRatio*(1.0_pREAL-StressRatio_p) ** prm%q) &
/ (prm%omega*effectiveLength)
- t_k = effectiveLength * prm%B /(2.0_pReal*prm%b_sl*tau_eff) ! corrected eq. (14)
+ t_k = effectiveLength * prm%B /(2.0_pREAL*prm%b_sl*tau_eff) ! corrected eq. (14)
dot_gamma_neg = b_rho_half * sign(prm%h/(t_n + t_k),tau_neg)
else where significantNegativeTau
- dot_gamma_neg = 0.0_pReal
+ dot_gamma_neg = 0.0_pREAL
end where significantNegativeTau
if (present(ddot_gamma_dtau_neg)) then
significantNegativeTau2: where(abs(tau_neg)-dst%tau_pass(:,en) > tol_math_check)
- dtn = -1.0_pReal * t_n * BoltzmannRatio * prm%p * prm%q * (1.0_pReal-StressRatio_p)**(prm%q - 1.0_pReal) &
+ dtn = -1.0_pREAL * t_n * BoltzmannRatio * prm%p * prm%q * (1.0_pREAL-StressRatio_p)**(prm%q - 1.0_pREAL) &
* StressRatio_pminus1 / prm%tau_Peierls
- dtk = -1.0_pReal * t_k / tau_neg
+ dtk = -1.0_pREAL * t_k / tau_neg
- dvel = -1.0_pReal * prm%h * (dtk + dtn) / (t_n + t_k)**2
+ dvel = -1.0_pREAL * prm%h * (dtk + dtn) / (t_n + t_k)**2
ddot_gamma_dtau_neg = b_rho_half * dvel
else where significantNegativeTau2
- ddot_gamma_dtau_neg = 0.0_pReal
+ ddot_gamma_dtau_neg = 0.0_pREAL
end where significantNegativeTau2
end if
diff --git a/src/phase_mechanical_plastic_dislotwin.f90 b/src/phase_mechanical_plastic_dislotwin.f90
index ee6ccb9d1..05becb028 100644
--- a/src/phase_mechanical_plastic_dislotwin.f90
+++ b/src/phase_mechanical_plastic_dislotwin.f90
@@ -9,31 +9,31 @@
!--------------------------------------------------------------------------------------------------
submodule(phase:plastic) dislotwin
- real(pReal), parameter :: gamma_char_tr = sqrt(0.125_pReal) !< Characteristic shear for transformation
+ real(pREAL), parameter :: gamma_char_tr = sqrt(0.125_pREAL) !< Characteristic shear for transformation
type :: tParameters
- real(pReal) :: &
- Q_cl = 1.0_pReal, & !< activation energy for dislocation climb
- omega = 1.0_pReal, & !< frequency factor for dislocation climb
- D = 1.0_pReal, & !< grain size
- p_sb = 1.0_pReal, & !< p-exponent in shear band velocity
- q_sb = 1.0_pReal, & !< q-exponent in shear band velocity
- i_tw = 1.0_pReal, & !< adjustment parameter to calculate MFP for twinning
- i_tr = 1.0_pReal, & !< adjustment parameter to calculate MFP for transformation
- L_tw = 1.0_pReal, & !< length of twin nuclei
- L_tr = 1.0_pReal, & !< length of trans nuclei
- x_c = 1.0_pReal, & !< critical distance for formation of twin/trans nucleus
- V_cs = 1.0_pReal, & !< cross slip volume
- tau_sb = 1.0_pReal, & !< value for shearband resistance
- gamma_0_sb = 1.0_pReal, & !< value for shearband velocity_0
- E_sb = 1.0_pReal, & !< activation energy for shear bands
- h = 1.0_pReal, & !< stack height of hex nucleus
- cOverA_hP = 1.0_pReal, &
- V_mol = 1.0_pReal, &
- rho = 1.0_pReal
+ real(pREAL) :: &
+ Q_cl = 1.0_pREAL, & !< activation energy for dislocation climb
+ omega = 1.0_pREAL, & !< frequency factor for dislocation climb
+ D = 1.0_pREAL, & !< grain size
+ p_sb = 1.0_pREAL, & !< p-exponent in shear band velocity
+ q_sb = 1.0_pREAL, & !< q-exponent in shear band velocity
+ i_tw = 1.0_pREAL, & !< adjustment parameter to calculate MFP for twinning
+ i_tr = 1.0_pREAL, & !< adjustment parameter to calculate MFP for transformation
+ L_tw = 1.0_pREAL, & !< length of twin nuclei
+ L_tr = 1.0_pREAL, & !< length of trans nuclei
+ x_c = 1.0_pREAL, & !< critical distance for formation of twin/trans nucleus
+ V_cs = 1.0_pREAL, & !< cross slip volume
+ tau_sb = 1.0_pREAL, & !< value for shearband resistance
+ gamma_0_sb = 1.0_pREAL, & !< value for shearband velocity_0
+ E_sb = 1.0_pREAL, & !< activation energy for shear bands
+ h = 1.0_pREAL, & !< stack height of hex nucleus
+ cOverA_hP = 1.0_pREAL, &
+ V_mol = 1.0_pREAL, &
+ rho = 1.0_pREAL
type(tPolynomial) :: &
Gamma_sf, & !< stacking fault energy
Delta_G !< free energy difference between austensite and martensite
- real(pReal), allocatable, dimension(:) :: &
+ real(pREAL), allocatable, dimension(:) :: &
b_sl, & !< absolute length of Burgers vector [m] for each slip system
b_tw, & !< absolute length of Burgers vector [m] for each twin system
b_tr, & !< absolute length of Burgers vector [m] for each transformation system
@@ -51,7 +51,7 @@ submodule(phase:plastic) dislotwin
gamma_char_tw, & !< characteristic shear for twins
B, & !< drag coefficient
d_caron !< distance of spontaneous annhihilation
- real(pReal), allocatable, dimension(:,:) :: &
+ real(pREAL), allocatable, dimension(:,:) :: &
h_sl_sl, & !< components of slip-slip interaction matrix
h_sl_tw, & !< components of slip-twin interaction matrix
h_sl_tr, & !< components of slip-trans interaction matrix
@@ -59,7 +59,7 @@ submodule(phase:plastic) dislotwin
h_tr_tr, & !< components of trans-trans interaction matrix
n0_sl, & !< slip system normal
forestProjection
- real(pReal), allocatable, dimension(:,:,:) :: &
+ real(pREAL), allocatable, dimension(:,:,:) :: &
P_sl, &
P_tw, &
P_tr
@@ -75,7 +75,7 @@ submodule(phase:plastic) dislotwin
character(len=:), allocatable :: &
lattice_tr, &
isotropic_bound
- character(len=pStringLen), allocatable, dimension(:) :: &
+ character(len=pSTRLEN), allocatable, dimension(:) :: &
output
logical :: &
extendedDislocations, & !< consider split into partials for climb calculation
@@ -96,7 +96,7 @@ submodule(phase:plastic) dislotwin
end type tIndexDotState
type :: tDislotwinState
- real(pReal), dimension(:,:), pointer :: &
+ real(pREAL), dimension(:,:), pointer :: &
rho_mob, &
rho_dip, &
gamma_sl, &
@@ -105,7 +105,7 @@ submodule(phase:plastic) dislotwin
end type tDislotwinState
type :: tDislotwinDependentState
- real(pReal), dimension(:,:), allocatable :: &
+ real(pREAL), dimension(:,:), allocatable :: &
Lambda_sl, & !< mean free path between 2 obstacles seen by a moving dislocation
Lambda_tw, & !< mean free path between 2 obstacles seen by a growing twin
Lambda_tr, & !< mean free path between 2 obstacles seen by a growing martensite
@@ -136,8 +136,8 @@ module function plastic_dislotwin_init() result(myPlasticity)
startIndex, endIndex
integer, dimension(:), allocatable :: &
N_sl
- real(pReal) :: a_cF
- real(pReal), allocatable, dimension(:) :: &
+ real(pREAL) :: a_cF
+ real(pREAL), allocatable, dimension(:) :: &
rho_mob_0, & !< initial unipolar dislocation density per slip system
rho_dip_0 !< initial dipole dislocation density per slip system
character(len=:), allocatable :: &
@@ -188,12 +188,12 @@ module function plastic_dislotwin_init() result(myPlasticity)
if (len(refs) > 0) print'(/,1x,a)', refs
#if defined (__GFORTRAN__)
- prm%output = output_as1dString(pl)
+ prm%output = output_as1dStr(pl)
#else
- prm%output = pl%get_as1dString('output',defaultVal=emptyStringArray)
+ prm%output = pl%get_as1dStr('output',defaultVal=emptyStrArray)
#endif
- prm%isotropic_bound = pl%get_asString('isotropic_bound',defaultVal='isostrain')
+ prm%isotropic_bound = pl%get_asStr('isotropic_bound',defaultVal='isostrain')
!--------------------------------------------------------------------------------------------------
! slip related parameters
@@ -202,7 +202,7 @@ module function plastic_dislotwin_init() result(myPlasticity)
slipActive: if (prm%sum_N_sl > 0) then
prm%systems_sl = lattice_labels_slip(N_sl,phase_lattice(ph))
prm%P_sl = lattice_SchmidMatrix_slip(N_sl,phase_lattice(ph),phase_cOverA(ph))
- prm%h_sl_sl = lattice_interaction_SlipBySlip(N_sl,pl%get_as1dFloat('h_sl-sl'),phase_lattice(ph))
+ prm%h_sl_sl = lattice_interaction_SlipBySlip(N_sl,pl%get_as1dReal('h_sl-sl'),phase_lattice(ph))
prm%forestProjection = lattice_forestProjection_edge(N_sl,phase_lattice(ph),phase_cOverA(ph))
prm%forestProjection = transpose(prm%forestProjection)
@@ -210,27 +210,27 @@ module function plastic_dislotwin_init() result(myPlasticity)
prm%fccTwinTransNucleation = phase_lattice(ph) == 'cF' .and. (N_sl(1) == 12)
if (prm%fccTwinTransNucleation) prm%fcc_twinNucleationSlipPair = lattice_CF_TWINNUCLEATIONSLIPPAIR
- rho_mob_0 = pl%get_as1dFloat('rho_mob_0', requiredSize=size(N_sl))
- rho_dip_0 = pl%get_as1dFloat('rho_dip_0', requiredSize=size(N_sl))
- prm%v_0 = pl%get_as1dFloat('v_0', requiredSize=size(N_sl))
- prm%b_sl = pl%get_as1dFloat('b_sl', requiredSize=size(N_sl))
- prm%Q_sl = pl%get_as1dFloat('Q_sl', requiredSize=size(N_sl))
- prm%i_sl = pl%get_as1dFloat('i_sl', requiredSize=size(N_sl))
- prm%p = pl%get_as1dFloat('p_sl', requiredSize=size(N_sl))
- prm%q = pl%get_as1dFloat('q_sl', requiredSize=size(N_sl))
- prm%tau_0 = pl%get_as1dFloat('tau_0', requiredSize=size(N_sl))
- prm%B = pl%get_as1dFloat('B', requiredSize=size(N_sl), &
- defaultVal=[(0.0_pReal, i=1,size(N_sl))])
+ rho_mob_0 = pl%get_as1dReal('rho_mob_0', requiredSize=size(N_sl))
+ rho_dip_0 = pl%get_as1dReal('rho_dip_0', requiredSize=size(N_sl))
+ prm%v_0 = pl%get_as1dReal('v_0', requiredSize=size(N_sl))
+ prm%b_sl = pl%get_as1dReal('b_sl', requiredSize=size(N_sl))
+ prm%Q_sl = pl%get_as1dReal('Q_sl', requiredSize=size(N_sl))
+ prm%i_sl = pl%get_as1dReal('i_sl', requiredSize=size(N_sl))
+ prm%p = pl%get_as1dReal('p_sl', requiredSize=size(N_sl))
+ prm%q = pl%get_as1dReal('q_sl', requiredSize=size(N_sl))
+ prm%tau_0 = pl%get_as1dReal('tau_0', requiredSize=size(N_sl))
+ prm%B = pl%get_as1dReal('B', requiredSize=size(N_sl), &
+ defaultVal=[(0.0_pREAL, i=1,size(N_sl))])
- prm%Q_cl = pl%get_asFloat('Q_cl')
+ prm%Q_cl = pl%get_asReal('Q_cl')
prm%extendedDislocations = pl%get_asBool('extend_dislocations',defaultVal = .false.)
prm%omitDipoles = pl%get_asBool('omit_dipoles',defaultVal = .false.)
! multiplication factor according to crystal structure (nearest neighbors bcc vs fcc/hex)
! details: Argon & Moffat, Acta Metallurgica, Vol. 29, pg 293 to 299, 1981
- prm%omega = pl%get_asFloat('omega', defaultVal = 1000.0_pReal) &
- * merge(12.0_pReal,8.0_pReal,any(phase_lattice(ph) == ['cF','hP']))
+ prm%omega = pl%get_asReal('omega', defaultVal = 1000.0_pREAL) &
+ * merge(12.0_pREAL,8.0_pREAL,any(phase_lattice(ph) == ['cF','hP']))
! expand: family => system
rho_mob_0 = math_expand(rho_mob_0, N_sl)
@@ -243,20 +243,20 @@ module function plastic_dislotwin_init() result(myPlasticity)
prm%q = math_expand(prm%q, N_sl)
prm%tau_0 = math_expand(prm%tau_0, N_sl)
prm%B = math_expand(prm%B, N_sl)
- prm%d_caron = pl%get_asFloat('D_a') * prm%b_sl
+ prm%d_caron = pl%get_asReal('D_a') * prm%b_sl
! sanity checks
- if ( prm%Q_cl <= 0.0_pReal) extmsg = trim(extmsg)//' Q_cl'
- if (any(rho_mob_0 < 0.0_pReal)) extmsg = trim(extmsg)//' rho_mob_0'
- if (any(rho_dip_0 < 0.0_pReal)) extmsg = trim(extmsg)//' rho_dip_0'
- if (any(prm%v_0 < 0.0_pReal)) extmsg = trim(extmsg)//' v_0'
- if (any(prm%b_sl <= 0.0_pReal)) extmsg = trim(extmsg)//' b_sl'
- if (any(prm%Q_sl <= 0.0_pReal)) extmsg = trim(extmsg)//' Q_sl'
- if (any(prm%i_sl <= 0.0_pReal)) extmsg = trim(extmsg)//' i_sl'
- if (any(prm%B < 0.0_pReal)) extmsg = trim(extmsg)//' B'
- if (any(prm%d_caron < 0.0_pReal)) extmsg = trim(extmsg)//' d_caron(D_a,b_sl)'
- if (any(prm%p<=0.0_pReal .or. prm%p>1.0_pReal)) extmsg = trim(extmsg)//' p_sl'
- if (any(prm%q< 1.0_pReal .or. prm%q>2.0_pReal)) extmsg = trim(extmsg)//' q_sl'
+ if ( prm%Q_cl <= 0.0_pREAL) extmsg = trim(extmsg)//' Q_cl'
+ if (any(rho_mob_0 < 0.0_pREAL)) extmsg = trim(extmsg)//' rho_mob_0'
+ if (any(rho_dip_0 < 0.0_pREAL)) extmsg = trim(extmsg)//' rho_dip_0'
+ if (any(prm%v_0 < 0.0_pREAL)) extmsg = trim(extmsg)//' v_0'
+ if (any(prm%b_sl <= 0.0_pREAL)) extmsg = trim(extmsg)//' b_sl'
+ if (any(prm%Q_sl <= 0.0_pREAL)) extmsg = trim(extmsg)//' Q_sl'
+ if (any(prm%i_sl <= 0.0_pREAL)) extmsg = trim(extmsg)//' i_sl'
+ if (any(prm%B < 0.0_pREAL)) extmsg = trim(extmsg)//' B'
+ if (any(prm%d_caron < 0.0_pREAL)) extmsg = trim(extmsg)//' d_caron(D_a,b_sl)'
+ if (any(prm%p<=0.0_pREAL .or. prm%p>1.0_pREAL)) extmsg = trim(extmsg)//' p_sl'
+ if (any(prm%q< 1.0_pREAL .or. prm%q>2.0_pREAL)) extmsg = trim(extmsg)//' q_sl'
else slipActive
rho_mob_0 = emptyRealArray; rho_dip_0 = emptyRealArray
allocate(prm%b_sl,prm%Q_sl,prm%v_0,prm%i_sl,prm%p,prm%q,prm%B,source=emptyRealArray)
@@ -270,15 +270,15 @@ module function plastic_dislotwin_init() result(myPlasticity)
twinActive: if (prm%sum_N_tw > 0) then
prm%systems_tw = lattice_labels_twin(prm%N_tw,phase_lattice(ph))
prm%P_tw = lattice_SchmidMatrix_twin(prm%N_tw,phase_lattice(ph),phase_cOverA(ph))
- prm%h_tw_tw = lattice_interaction_TwinByTwin(prm%N_tw,pl%get_as1dFloat('h_tw-tw'), &
+ prm%h_tw_tw = lattice_interaction_TwinByTwin(prm%N_tw,pl%get_as1dReal('h_tw-tw'), &
phase_lattice(ph))
- prm%b_tw = pl%get_as1dFloat('b_tw', requiredSize=size(prm%N_tw))
- prm%t_tw = pl%get_as1dFloat('t_tw', requiredSize=size(prm%N_tw))
- prm%r = pl%get_as1dFloat('p_tw', requiredSize=size(prm%N_tw))
+ prm%b_tw = pl%get_as1dReal('b_tw', requiredSize=size(prm%N_tw))
+ prm%t_tw = pl%get_as1dReal('t_tw', requiredSize=size(prm%N_tw))
+ prm%r = pl%get_as1dReal('p_tw', requiredSize=size(prm%N_tw))
- prm%L_tw = pl%get_asFloat('L_tw')
- prm%i_tw = pl%get_asFloat('i_tw')
+ prm%L_tw = pl%get_asReal('L_tw')
+ prm%i_tw = pl%get_asReal('i_tw')
prm%gamma_char_tw = lattice_characteristicShear_Twin(prm%N_tw,phase_lattice(ph),phase_cOverA(ph))
@@ -289,11 +289,11 @@ module function plastic_dislotwin_init() result(myPlasticity)
! sanity checks
if (.not. prm%fccTwinTransNucleation) extmsg = trim(extmsg)//' TWIP for non-fcc'
- if ( prm%L_tw < 0.0_pReal) extmsg = trim(extmsg)//' L_tw'
- if ( prm%i_tw < 0.0_pReal) extmsg = trim(extmsg)//' i_tw'
- if (any(prm%b_tw < 0.0_pReal)) extmsg = trim(extmsg)//' b_tw'
- if (any(prm%t_tw < 0.0_pReal)) extmsg = trim(extmsg)//' t_tw'
- if (any(prm%r < 0.0_pReal)) extmsg = trim(extmsg)//' p_tw'
+ if ( prm%L_tw < 0.0_pREAL) extmsg = trim(extmsg)//' L_tw'
+ if ( prm%i_tw < 0.0_pREAL) extmsg = trim(extmsg)//' i_tw'
+ if (any(prm%b_tw < 0.0_pREAL)) extmsg = trim(extmsg)//' b_tw'
+ if (any(prm%t_tw < 0.0_pREAL)) extmsg = trim(extmsg)//' t_tw'
+ if (any(prm%r < 0.0_pREAL)) extmsg = trim(extmsg)//' p_tw'
else twinActive
allocate(prm%gamma_char_tw,prm%b_tw,prm%t_tw,prm%r,source=emptyRealArray)
allocate(prm%h_tw_tw(0,0))
@@ -304,34 +304,34 @@ module function plastic_dislotwin_init() result(myPlasticity)
prm%N_tr = pl%get_as1dInt('N_tr', defaultVal=emptyIntArray)
prm%sum_N_tr = sum(abs(prm%N_tr))
transActive: if (prm%sum_N_tr > 0) then
- prm%b_tr = pl%get_as1dFloat('b_tr')
+ prm%b_tr = pl%get_as1dReal('b_tr')
prm%b_tr = math_expand(prm%b_tr,prm%N_tr)
- prm%i_tr = pl%get_asFloat('i_tr')
+ prm%i_tr = pl%get_asReal('i_tr')
prm%Delta_G = polynomial(pl,'Delta_G','T')
- prm%L_tr = pl%get_asFloat('L_tr')
- a_cF = prm%b_tr(1)*sqrt(6.0_pReal) ! b_tr is Shockley partial
- prm%h = 5.0_pReal * a_cF/sqrt(3.0_pReal)
- prm%cOverA_hP = pl%get_asFloat('c/a_hP')
- prm%rho = 4.0_pReal/(sqrt(3.0_pReal)*a_cF**2)/N_A
- prm%V_mol = pl%get_asFloat('V_mol')
- prm%h_tr_tr = lattice_interaction_TransByTrans(prm%N_tr,pl%get_as1dFloat('h_tr-tr'),&
+ prm%L_tr = pl%get_asReal('L_tr')
+ a_cF = prm%b_tr(1)*sqrt(6.0_pREAL) ! b_tr is Shockley partial
+ prm%h = 5.0_pREAL * a_cF/sqrt(3.0_pREAL)
+ prm%cOverA_hP = pl%get_asReal('c/a_hP')
+ prm%rho = 4.0_pREAL/(sqrt(3.0_pREAL)*a_cF**2)/N_A
+ prm%V_mol = pl%get_asReal('V_mol')
+ prm%h_tr_tr = lattice_interaction_TransByTrans(prm%N_tr,pl%get_as1dReal('h_tr-tr'),&
phase_lattice(ph))
prm%P_tr = lattice_SchmidMatrix_trans(prm%N_tr,'hP',prm%cOverA_hP)
- prm%t_tr = pl%get_as1dFloat('t_tr')
+ prm%t_tr = pl%get_as1dReal('t_tr')
prm%t_tr = math_expand(prm%t_tr,prm%N_tr)
- prm%s = pl%get_as1dFloat('p_tr')
+ prm%s = pl%get_as1dReal('p_tr')
prm%s = math_expand(prm%s,prm%N_tr)
! sanity checks
if (.not. prm%fccTwinTransNucleation) extmsg = trim(extmsg)//' TRIP for non-fcc'
- if ( prm%L_tr < 0.0_pReal) extmsg = trim(extmsg)//' L_tr'
- if ( prm%V_mol < 0.0_pReal) extmsg = trim(extmsg)//' V_mol'
- if ( prm%i_tr < 0.0_pReal) extmsg = trim(extmsg)//' i_tr'
- if (any(prm%t_tr < 0.0_pReal)) extmsg = trim(extmsg)//' t_tr'
- if (any(prm%s < 0.0_pReal)) extmsg = trim(extmsg)//' p_tr'
+ if ( prm%L_tr < 0.0_pREAL) extmsg = trim(extmsg)//' L_tr'
+ if ( prm%V_mol < 0.0_pREAL) extmsg = trim(extmsg)//' V_mol'
+ if ( prm%i_tr < 0.0_pREAL) extmsg = trim(extmsg)//' i_tr'
+ if (any(prm%t_tr < 0.0_pREAL)) extmsg = trim(extmsg)//' t_tr'
+ if (any(prm%s < 0.0_pREAL)) extmsg = trim(extmsg)//' p_tr'
else transActive
allocate(prm%s,prm%b_tr,prm%t_tr,source=emptyRealArray)
allocate(prm%h_tr_tr(0,0))
@@ -339,43 +339,43 @@ module function plastic_dislotwin_init() result(myPlasticity)
!--------------------------------------------------------------------------------------------------
! shearband related parameters
- prm%gamma_0_sb = pl%get_asFloat('gamma_0_sb',defaultVal=0.0_pReal)
- if (prm%gamma_0_sb > 0.0_pReal) then
- prm%tau_sb = pl%get_asFloat('tau_sb')
- prm%E_sb = pl%get_asFloat('Q_sb')
- prm%p_sb = pl%get_asFloat('p_sb')
- prm%q_sb = pl%get_asFloat('q_sb')
+ prm%gamma_0_sb = pl%get_asReal('gamma_0_sb',defaultVal=0.0_pREAL)
+ if (prm%gamma_0_sb > 0.0_pREAL) then
+ prm%tau_sb = pl%get_asReal('tau_sb')
+ prm%E_sb = pl%get_asReal('Q_sb')
+ prm%p_sb = pl%get_asReal('p_sb')
+ prm%q_sb = pl%get_asReal('q_sb')
! sanity checks
- if (prm%tau_sb < 0.0_pReal) extmsg = trim(extmsg)//' tau_sb'
- if (prm%E_sb < 0.0_pReal) extmsg = trim(extmsg)//' Q_sb'
- if (prm%p_sb <= 0.0_pReal) extmsg = trim(extmsg)//' p_sb'
- if (prm%q_sb <= 0.0_pReal) extmsg = trim(extmsg)//' q_sb'
+ if (prm%tau_sb < 0.0_pREAL) extmsg = trim(extmsg)//' tau_sb'
+ if (prm%E_sb < 0.0_pREAL) extmsg = trim(extmsg)//' Q_sb'
+ if (prm%p_sb <= 0.0_pREAL) extmsg = trim(extmsg)//' p_sb'
+ if (prm%q_sb <= 0.0_pREAL) extmsg = trim(extmsg)//' q_sb'
end if
!--------------------------------------------------------------------------------------------------
! parameters required for several mechanisms and their interactions
if (prm%sum_N_sl + prm%sum_N_tw + prm%sum_N_tw > 0) &
- prm%D = pl%get_asFloat('D')
+ prm%D = pl%get_asReal('D')
if (prm%sum_N_tw + prm%sum_N_tr > 0) then
- prm%x_c = pl%get_asFloat('x_c')
- prm%V_cs = pl%get_asFloat('V_cs')
- if (prm%x_c < 0.0_pReal) extmsg = trim(extmsg)//' x_c'
- if (prm%V_cs < 0.0_pReal) extmsg = trim(extmsg)//' V_cs'
+ prm%x_c = pl%get_asReal('x_c')
+ prm%V_cs = pl%get_asReal('V_cs')
+ if (prm%x_c < 0.0_pREAL) extmsg = trim(extmsg)//' x_c'
+ if (prm%V_cs < 0.0_pREAL) extmsg = trim(extmsg)//' V_cs'
end if
if (prm%sum_N_tw + prm%sum_N_tr > 0 .or. prm%extendedDislocations) &
prm%Gamma_sf = polynomial(pl,'Gamma_sf','T')
slipAndTwinActive: if (prm%sum_N_sl * prm%sum_N_tw > 0) then
- prm%h_sl_tw = lattice_interaction_SlipByTwin(N_sl,prm%N_tw,pl%get_as1dFloat('h_sl-tw'), &
+ prm%h_sl_tw = lattice_interaction_SlipByTwin(N_sl,prm%N_tw,pl%get_as1dReal('h_sl-tw'), &
phase_lattice(ph))
if (prm%fccTwinTransNucleation .and. size(prm%N_tw) /= 1) extmsg = trim(extmsg)//' N_tw: nucleation'
end if slipAndTwinActive
slipAndTransActive: if (prm%sum_N_sl * prm%sum_N_tr > 0) then
- prm%h_sl_tr = lattice_interaction_SlipByTrans(N_sl,prm%N_tr,pl%get_as1dFloat('h_sl-tr'), &
+ prm%h_sl_tr = lattice_interaction_SlipByTrans(N_sl,prm%N_tr,pl%get_as1dReal('h_sl-tr'), &
phase_lattice(ph))
if (prm%fccTwinTransNucleation .and. size(prm%N_tr) /= 1) extmsg = trim(extmsg)//' N_tr: nucleation'
end if slipAndTransActive
@@ -402,41 +402,41 @@ module function plastic_dislotwin_init() result(myPlasticity)
idx_dot%rho_mob = [startIndex,endIndex]
stt%rho_mob=>plasticState(ph)%state(startIndex:endIndex,:)
stt%rho_mob= spread(rho_mob_0,2,Nmembers)
- plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_rho',defaultVal=1.0_pReal)
- if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_rho'
+ plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_rho',defaultVal=1.0_pREAL)
+ if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pREAL)) extmsg = trim(extmsg)//' atol_rho'
startIndex = endIndex + 1
endIndex = endIndex + prm%sum_N_sl
idx_dot%rho_dip = [startIndex,endIndex]
stt%rho_dip=>plasticState(ph)%state(startIndex:endIndex,:)
stt%rho_dip= spread(rho_dip_0,2,Nmembers)
- plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_rho',defaultVal=1.0_pReal)
+ plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_rho',defaultVal=1.0_pREAL)
startIndex = endIndex + 1
endIndex = endIndex + prm%sum_N_sl
idx_dot%gamma_sl = [startIndex,endIndex]
stt%gamma_sl=>plasticState(ph)%state(startIndex:endIndex,:)
- plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_gamma',defaultVal=1.0e-6_pReal)
- if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_gamma'
+ plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_gamma',defaultVal=1.0e-6_pREAL)
+ if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pREAL)) extmsg = trim(extmsg)//' atol_gamma'
startIndex = endIndex + 1
endIndex = endIndex + prm%sum_N_tw
idx_dot%f_tw = [startIndex,endIndex]
stt%f_tw=>plasticState(ph)%state(startIndex:endIndex,:)
- plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_f_tw',defaultVal=1.0e-6_pReal)
- if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_f_tw'
+ plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_f_tw',defaultVal=1.0e-6_pREAL)
+ if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pREAL)) extmsg = trim(extmsg)//' atol_f_tw'
startIndex = endIndex + 1
endIndex = endIndex + prm%sum_N_tr
idx_dot%f_tr = [startIndex,endIndex]
stt%f_tr=>plasticState(ph)%state(startIndex:endIndex,:)
- plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_f_tr',defaultVal=1.0e-6_pReal)
- if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_f_tr'
+ plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_f_tr',defaultVal=1.0e-6_pREAL)
+ if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pREAL)) extmsg = trim(extmsg)//' atol_f_tr'
- allocate(dst%tau_pass (prm%sum_N_sl,Nmembers),source=0.0_pReal)
- allocate(dst%Lambda_sl(prm%sum_N_sl,Nmembers),source=0.0_pReal)
- allocate(dst%Lambda_tw(prm%sum_N_tw,Nmembers),source=0.0_pReal)
- allocate(dst%Lambda_tr(prm%sum_N_tr,Nmembers),source=0.0_pReal)
+ allocate(dst%tau_pass (prm%sum_N_sl,Nmembers),source=0.0_pREAL)
+ allocate(dst%Lambda_sl(prm%sum_N_sl,Nmembers),source=0.0_pREAL)
+ allocate(dst%Lambda_tw(prm%sum_N_tw,Nmembers),source=0.0_pREAL)
+ allocate(dst%Lambda_tr(prm%sum_N_tr,Nmembers),source=0.0_pREAL)
end associate
@@ -456,21 +456,21 @@ module function plastic_dislotwin_homogenizedC(ph,en) result(homogenizedC)
integer, intent(in) :: &
ph, en
- real(pReal), dimension(6,6) :: &
+ real(pREAL), dimension(6,6) :: &
homogenizedC, &
C
- real(pReal), dimension(:,:,:), allocatable :: &
+ real(pREAL), dimension(:,:,:), allocatable :: &
C66_tw, &
C66_tr
integer :: i
- real(pReal) :: f_matrix
+ real(pREAL) :: f_matrix
C = elastic_C66(ph,en)
associate(prm => param(ph), stt => state(ph))
- f_matrix = 1.0_pReal &
+ f_matrix = 1.0_pREAL &
- sum(stt%f_tw(1:prm%sum_N_tw,en)) &
- sum(stt%f_tr(1:prm%sum_N_tr,en))
@@ -502,28 +502,28 @@ end function plastic_dislotwin_homogenizedC
!--------------------------------------------------------------------------------------------------
module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
- real(pReal), dimension(3,3), intent(out) :: Lp
- real(pReal), dimension(3,3,3,3), intent(out) :: dLp_dMp
- real(pReal), dimension(3,3), intent(in) :: Mp
+ real(pREAL), dimension(3,3), intent(out) :: Lp
+ real(pREAL), dimension(3,3,3,3), intent(out) :: dLp_dMp
+ real(pREAL), dimension(3,3), intent(in) :: Mp
integer, intent(in) :: ph,en
integer :: i,k,l,m,n
- real(pReal) :: &
+ real(pREAL) :: &
f_matrix,StressRatio_p,&
E_kB_T, &
ddot_gamma_dtau, &
tau, &
T
- real(pReal), dimension(param(ph)%sum_N_sl) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl) :: &
dot_gamma_sl,ddot_gamma_dtau_sl
- real(pReal), dimension(param(ph)%sum_N_tw) :: &
+ real(pREAL), dimension(param(ph)%sum_N_tw) :: &
dot_gamma_tw,ddot_gamma_dtau_tw
- real(pReal), dimension(param(ph)%sum_N_tr) :: &
+ real(pREAL), dimension(param(ph)%sum_N_tr) :: &
dot_gamma_tr,ddot_gamma_dtau_tr
- real(pReal):: dot_gamma_sb
- real(pReal), dimension(3,3) :: eigVectors, P_sb
- real(pReal), dimension(3) :: eigValues
- real(pReal), dimension(3,6), parameter :: &
+ real(pREAL):: dot_gamma_sb
+ real(pREAL), dimension(3,3) :: eigVectors, P_sb
+ real(pREAL), dimension(3) :: eigValues
+ real(pREAL), dimension(3,6), parameter :: &
sb_sComposition = &
reshape(real([&
1, 0, 1, &
@@ -532,7 +532,7 @@ module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
1,-1, 0, &
0, 1, 1, &
0, 1,-1 &
- ],pReal),[ 3,6]), &
+ ],pREAL),[ 3,6]), &
sb_mComposition = &
reshape(real([&
1, 0,-1, &
@@ -541,16 +541,16 @@ module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
1, 1, 0, &
0, 1,-1, &
0, 1, 1 &
- ],pReal),[ 3,6])
+ ],pREAL),[ 3,6])
T = thermal_T(ph,en)
- Lp = 0.0_pReal
- dLp_dMp = 0.0_pReal
+ Lp = 0.0_pREAL
+ dLp_dMp = 0.0_pREAL
associate(prm => param(ph), stt => state(ph))
- f_matrix = 1.0_pReal &
+ f_matrix = 1.0_pREAL &
- sum(stt%f_tw(1:prm%sum_N_tw,en)) &
- sum(stt%f_tr(1:prm%sum_N_tr,en))
@@ -587,7 +587,7 @@ module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
call math_eigh33(eigValues,eigVectors,Mp) ! is Mp symmetric by design?
do i = 1,6
- P_sb = 0.5_pReal * math_outer(matmul(eigVectors,sb_sComposition(1:3,i)),&
+ P_sb = 0.5_pREAL * math_outer(matmul(eigVectors,sb_sComposition(1:3,i)),&
matmul(eigVectors,sb_mComposition(1:3,i)))
tau = math_tensordot(Mp,P_sb)
@@ -595,8 +595,8 @@ module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
StressRatio_p = (abs(tau)/prm%tau_sb)**prm%p_sb
dot_gamma_sb = sign(prm%gamma_0_sb*exp(-E_kB_T*(1-StressRatio_p)**prm%q_sb), tau)
ddot_gamma_dtau = abs(dot_gamma_sb)*E_kB_T*prm%p_sb*prm%q_sb/prm%tau_sb &
- * (abs(tau)/prm%tau_sb)**(prm%p_sb-1.0_pReal) &
- * (1.0_pReal-StressRatio_p)**(prm%q_sb-1.0_pReal)
+ * (abs(tau)/prm%tau_sb)**(prm%p_sb-1.0_pREAL) &
+ * (1.0_pREAL-StressRatio_p)**(prm%q_sb-1.0_pREAL)
Lp = Lp + dot_gamma_sb * P_sb
forall (k=1:3,l=1:3,m=1:3,n=1:3) &
@@ -617,31 +617,31 @@ end subroutine dislotwin_LpAndItsTangent
!--------------------------------------------------------------------------------------------------
module function dislotwin_dotState(Mp,ph,en) result(dotState)
- real(pReal), dimension(3,3), intent(in):: &
+ real(pREAL), dimension(3,3), intent(in):: &
Mp !< Mandel stress
integer, intent(in) :: &
ph, &
en
- real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+ real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
dotState
integer :: i
- real(pReal) :: &
+ real(pREAL) :: &
f_matrix, &
d_hat, &
v_cl, & !< climb velocity
tau, &
sigma_cl, & !< climb stress
b_d !< ratio of Burgers vector to stacking fault width
- real(pReal), dimension(param(ph)%sum_N_sl) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl) :: &
dot_rho_dip_formation, &
dot_rho_dip_climb, &
dot_gamma_sl
- real(pReal), dimension(param(ph)%sum_N_tw) :: &
+ real(pREAL), dimension(param(ph)%sum_N_tw) :: &
dot_gamma_tw
- real(pReal), dimension(param(ph)%sum_N_tr) :: &
+ real(pREAL), dimension(param(ph)%sum_N_tr) :: &
dot_gamma_tr
- real(pReal) :: &
+ real(pREAL) :: &
mu, nu, &
T
@@ -657,7 +657,7 @@ module function dislotwin_dotState(Mp,ph,en) result(dotState)
nu = elastic_nu(ph,en,prm%isotropic_bound)
T = thermal_T(ph,en)
- f_matrix = 1.0_pReal &
+ f_matrix = 1.0_pREAL &
- sum(stt%f_tw(1:prm%sum_N_tw,en)) &
- sum(stt%f_tr(1:prm%sum_N_tr,en))
@@ -668,30 +668,30 @@ module function dislotwin_dotState(Mp,ph,en) result(dotState)
tau = math_tensordot(Mp,prm%P_sl(1:3,1:3,i))
significantSlipStress: if (dEq0(tau) .or. prm%omitDipoles) then
- dot_rho_dip_formation(i) = 0.0_pReal
- dot_rho_dip_climb(i) = 0.0_pReal
+ dot_rho_dip_formation(i) = 0.0_pREAL
+ dot_rho_dip_climb(i) = 0.0_pREAL
else significantSlipStress
- d_hat = 3.0_pReal*mu*prm%b_sl(i)/(16.0_pReal*PI*abs(tau))
+ d_hat = 3.0_pREAL*mu*prm%b_sl(i)/(16.0_pREAL*PI*abs(tau))
d_hat = math_clip(d_hat, right = dst%Lambda_sl(i,en))
d_hat = math_clip(d_hat, left = prm%d_caron(i))
- dot_rho_dip_formation(i) = 2.0_pReal*(d_hat-prm%d_caron(i))/prm%b_sl(i) &
+ dot_rho_dip_formation(i) = 2.0_pREAL*(d_hat-prm%d_caron(i))/prm%b_sl(i) &
* stt%rho_mob(i,en)*abs_dot_gamma_sl(i)
if (dEq(d_hat,prm%d_caron(i))) then
- dot_rho_dip_climb(i) = 0.0_pReal
+ dot_rho_dip_climb(i) = 0.0_pREAL
else
! Argon & Moffat, Acta Metallurgica, Vol. 29, pg 293 to 299, 1981
sigma_cl = dot_product(prm%n0_sl(1:3,i),matmul(Mp,prm%n0_sl(1:3,i)))
if (prm%extendedDislocations) then
- b_d = 24.0_pReal*PI*(1.0_pReal - nu)/(2.0_pReal + nu) * prm%Gamma_sf%at(T) / (mu*prm%b_sl(i))
+ b_d = 24.0_pREAL*PI*(1.0_pREAL - nu)/(2.0_pREAL + nu) * prm%Gamma_sf%at(T) / (mu*prm%b_sl(i))
else
- b_d = 1.0_pReal
+ b_d = 1.0_pREAL
end if
- v_cl = 2.0_pReal*prm%omega*b_d**2*exp(-prm%Q_cl/(K_B*T)) &
- * (exp(abs(sigma_cl)*prm%b_sl(i)**3/(K_B*T)) - 1.0_pReal)
+ v_cl = 2.0_pREAL*prm%omega*b_d**2*exp(-prm%Q_cl/(K_B*T)) &
+ * (exp(abs(sigma_cl)*prm%b_sl(i)**3/(K_B*T)) - 1.0_pREAL)
- dot_rho_dip_climb(i) = 4.0_pReal*v_cl*stt%rho_dip(i,en) &
+ dot_rho_dip_climb(i) = 4.0_pREAL*v_cl*stt%rho_dip(i,en) &
/ (d_hat-prm%d_caron(i))
end if
end if significantSlipStress
@@ -699,10 +699,10 @@ module function dislotwin_dotState(Mp,ph,en) result(dotState)
dot_rho_mob = abs_dot_gamma_sl/(prm%b_sl*dst%Lambda_sl(:,en)) &
- dot_rho_dip_formation &
- - 2.0_pReal*prm%d_caron/prm%b_sl * stt%rho_mob(:,en)*abs_dot_gamma_sl
+ - 2.0_pREAL*prm%d_caron/prm%b_sl * stt%rho_mob(:,en)*abs_dot_gamma_sl
dot_rho_dip = dot_rho_dip_formation &
- - 2.0_pReal*prm%d_caron/prm%b_sl * stt%rho_dip(:,en)*abs_dot_gamma_sl &
+ - 2.0_pREAL*prm%d_caron/prm%b_sl * stt%rho_dip(:,en)*abs_dot_gamma_sl &
- dot_rho_dip_climb
if (prm%sum_N_tw > 0) call kinetics_tw(Mp,T,abs_dot_gamma_sl,ph,en,dot_gamma_tw)
@@ -725,17 +725,17 @@ module subroutine dislotwin_dependentState(ph,en)
ph, &
en
- real(pReal) :: &
+ real(pREAL) :: &
sumf_tw, sumf_tr
- real(pReal), dimension(param(ph)%sum_N_sl) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl) :: &
inv_lambda_sl
- real(pReal), dimension(param(ph)%sum_N_tw) :: &
+ real(pREAL), dimension(param(ph)%sum_N_tw) :: &
inv_lambda_tw_tw, & !< 1/mean free distance between 2 twin stacks from different systems seen by a growing twin
f_over_t_tw
- real(pReal), dimension(param(ph)%sum_N_tr) :: &
+ real(pREAL), dimension(param(ph)%sum_N_tr) :: &
inv_lambda_tr_tr, & !< 1/mean free distance between 2 martensite stacks from different systems seen by a growing martensite
f_over_t_tr
- real(pReal) :: &
+ real(pREAL) :: &
mu
@@ -752,16 +752,16 @@ module subroutine dislotwin_dependentState(ph,en)
inv_lambda_sl = sqrt(matmul(prm%forestProjection,stt%rho_mob(:,en)+stt%rho_dip(:,en)))/prm%i_sl
if (prm%sum_N_tw > 0 .and. prm%sum_N_sl > 0) &
- inv_lambda_sl = inv_lambda_sl + matmul(prm%h_sl_tw,f_over_t_tw)/(1.0_pReal-sumf_tw)
+ inv_lambda_sl = inv_lambda_sl + matmul(prm%h_sl_tw,f_over_t_tw)/(1.0_pREAL-sumf_tw)
if (prm%sum_N_tr > 0 .and. prm%sum_N_sl > 0) &
- inv_lambda_sl = inv_lambda_sl + matmul(prm%h_sl_tr,f_over_t_tr)/(1.0_pReal-sumf_tr)
- dst%Lambda_sl(:,en) = prm%D / (1.0_pReal+prm%D*inv_lambda_sl)
+ inv_lambda_sl = inv_lambda_sl + matmul(prm%h_sl_tr,f_over_t_tr)/(1.0_pREAL-sumf_tr)
+ dst%Lambda_sl(:,en) = prm%D / (1.0_pREAL+prm%D*inv_lambda_sl)
- inv_lambda_tw_tw = matmul(prm%h_tw_tw,f_over_t_tw)/(1.0_pReal-sumf_tw)
- dst%Lambda_tw(:,en) = prm%i_tw*prm%D/(1.0_pReal+prm%D*inv_lambda_tw_tw)
+ inv_lambda_tw_tw = matmul(prm%h_tw_tw,f_over_t_tw)/(1.0_pREAL-sumf_tw)
+ dst%Lambda_tw(:,en) = prm%i_tw*prm%D/(1.0_pREAL+prm%D*inv_lambda_tw_tw)
- inv_lambda_tr_tr = matmul(prm%h_tr_tr,f_over_t_tr)/(1.0_pReal-sumf_tr)
- dst%Lambda_tr(:,en) = prm%i_tr*prm%D/(1.0_pReal+prm%D*inv_lambda_tr_tr)
+ inv_lambda_tr_tr = matmul(prm%h_tr_tr,f_over_t_tr)/(1.0_pREAL-sumf_tr)
+ dst%Lambda_tr(:,en) = prm%i_tr*prm%D/(1.0_pREAL+prm%D*inv_lambda_tr_tr)
!* threshold stress for dislocation motion
dst%tau_pass(:,en) = mu*prm%b_sl* sqrt(matmul(prm%h_sl_sl,stt%rho_mob(:,en)+stt%rho_dip(:,en)))
@@ -834,22 +834,22 @@ end subroutine plastic_dislotwin_result
pure subroutine kinetics_sl(Mp,T,ph,en, &
dot_gamma_sl,ddot_gamma_dtau_sl,tau_sl)
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
- real(pReal), intent(in) :: &
+ real(pREAL), intent(in) :: &
T !< temperature
integer, intent(in) :: &
ph, &
en
- real(pReal), dimension(param(ph)%sum_N_sl), intent(out) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl), intent(out) :: &
dot_gamma_sl
- real(pReal), dimension(param(ph)%sum_N_sl), optional, intent(out) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl), optional, intent(out) :: &
ddot_gamma_dtau_sl, &
tau_sl
- real(pReal), dimension(param(ph)%sum_N_sl) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl) :: &
ddot_gamma_dtau
- real(pReal), dimension(param(ph)%sum_N_sl) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl) :: &
tau, &
stressRatio, &
StressRatio_p, &
@@ -873,23 +873,23 @@ pure subroutine kinetics_sl(Mp,T,ph,en, &
stressRatio = tau_eff/prm%tau_0
StressRatio_p = stressRatio** prm%p
Q_kB_T = prm%Q_sl/(K_B*T)
- v_wait_inverse = exp(Q_kB_T*(1.0_pReal-StressRatio_p)** prm%q) &
+ v_wait_inverse = exp(Q_kB_T*(1.0_pREAL-StressRatio_p)** prm%q) &
/ prm%v_0
v_run_inverse = prm%B/(tau_eff*prm%b_sl)
dot_gamma_sl = sign(stt%rho_mob(:,en)*prm%b_sl/(v_wait_inverse+v_run_inverse),tau)
- dV_wait_inverse_dTau = -1.0_pReal * v_wait_inverse * prm%p * prm%q * Q_kB_T &
- * (stressRatio**(prm%p-1.0_pReal)) &
- * (1.0_pReal-StressRatio_p)**(prm%q-1.0_pReal) &
+ dV_wait_inverse_dTau = -1.0_pREAL * v_wait_inverse * prm%p * prm%q * Q_kB_T &
+ * (stressRatio**(prm%p-1.0_pREAL)) &
+ * (1.0_pREAL-StressRatio_p)**(prm%q-1.0_pREAL) &
/ prm%tau_0
- dV_run_inverse_dTau = -1.0_pReal * v_run_inverse/tau_eff
- dV_dTau = -1.0_pReal * (dV_wait_inverse_dTau+dV_run_inverse_dTau) &
+ dV_run_inverse_dTau = -1.0_pREAL * v_run_inverse/tau_eff
+ dV_dTau = -1.0_pREAL * (dV_wait_inverse_dTau+dV_run_inverse_dTau) &
/ (v_wait_inverse+v_run_inverse)**2
ddot_gamma_dtau = dV_dTau*stt%rho_mob(:,en)*prm%b_sl
else where significantStress
- dot_gamma_sl = 0.0_pReal
- ddot_gamma_dtau = 0.0_pReal
+ dot_gamma_sl = 0.0_pREAL
+ ddot_gamma_dtau = 0.0_pREAL
end where significantStress
end associate
@@ -910,21 +910,21 @@ end subroutine kinetics_sl
pure subroutine kinetics_tw(Mp,T,abs_dot_gamma_sl,ph,en,&
dot_gamma_tw,ddot_gamma_dtau_tw)
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
- real(pReal), intent(in) :: &
+ real(pREAL), intent(in) :: &
T !< temperature
integer, intent(in) :: &
ph, &
en
- real(pReal), dimension(param(ph)%sum_N_sl), intent(in) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl), intent(in) :: &
abs_dot_gamma_sl
- real(pReal), dimension(param(ph)%sum_N_tw), intent(out) :: &
+ real(pREAL), dimension(param(ph)%sum_N_tw), intent(out) :: &
dot_gamma_tw
- real(pReal), dimension(param(ph)%sum_N_tw), optional, intent(out) :: &
+ real(pREAL), dimension(param(ph)%sum_N_tw), optional, intent(out) :: &
ddot_gamma_dtau_tw
- real(pReal) :: &
+ real(pREAL) :: &
tau, tau_r, tau_hat, &
dot_N_0, &
x0, V, &
@@ -943,10 +943,10 @@ pure subroutine kinetics_tw(Mp,T,abs_dot_gamma_sl,ph,en,&
nu = elastic_nu(ph,en,prm%isotropic_bound)
Gamma_sf = prm%Gamma_sf%at(T)
- tau_hat = 3.0_pReal*prm%b_tw(1)*mu/prm%L_tw &
- + Gamma_sf/(3.0_pReal*prm%b_tw(1))
- x0 = mu*prm%b_sl(1)**2*(2.0_pReal+nu)/(Gamma_sf*8.0_pReal*PI*(1.0_pReal-nu))
- tau_r = mu*prm%b_sl(1)/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%x_c)+cos(PI/3.0_pReal)/x0)
+ tau_hat = 3.0_pREAL*prm%b_tw(1)*mu/prm%L_tw &
+ + Gamma_sf/(3.0_pREAL*prm%b_tw(1))
+ x0 = mu*prm%b_sl(1)**2*(2.0_pREAL+nu)/(Gamma_sf*8.0_pREAL*PI*(1.0_pREAL-nu))
+ tau_r = mu*prm%b_sl(1)/(2.0_pREAL*PI)*(1.0_pREAL/(x0+prm%x_c)+cos(PI/3.0_pREAL)/x0)
do i = 1, prm%sum_N_tw
tau = math_tensordot(Mp,prm%P_tw(1:3,1:3,i))
@@ -956,18 +956,18 @@ pure subroutine kinetics_tw(Mp,T,abs_dot_gamma_sl,ph,en,&
dP_dTau = prm%r(i) * (tau_hat/tau)**prm%r(i)/tau * P
s = prm%fcc_twinNucleationSlipPair(1:2,i)
- dot_N_0 = sum(abs_dot_gamma_sl(s(2:1:-1))*(stt%rho_mob(s,en)+stt%rho_dip(s,en)))/(prm%L_tw*3.0_pReal)
+ dot_N_0 = sum(abs_dot_gamma_sl(s(2:1:-1))*(stt%rho_mob(s,en)+stt%rho_dip(s,en)))/(prm%L_tw*3.0_pREAL)
- P_ncs = 1.0_pReal-exp(-prm%V_cs/(K_B*T)*(tau_r-tau))
- dP_ncs_dtau = prm%V_cs / (K_B * T) * (P_ncs - 1.0_pReal)
+ P_ncs = 1.0_pREAL-exp(-prm%V_cs/(K_B*T)*(tau_r-tau))
+ dP_ncs_dtau = prm%V_cs / (K_B * T) * (P_ncs - 1.0_pREAL)
- V = PI/4.0_pReal*dst%Lambda_tw(i,en)**2*prm%t_tw(i)
+ V = PI/4.0_pREAL*dst%Lambda_tw(i,en)**2*prm%t_tw(i)
dot_gamma_tw(i) = V*dot_N_0*P_ncs*P*prm%gamma_char_tw(i)
if (present(ddot_gamma_dtau_tw)) &
ddot_gamma_dtau_tw(i) = V*dot_N_0*(P*dP_ncs_dtau + P_ncs*dP_dtau)*prm%gamma_char_tw(i)
else
- dot_gamma_tw(i) = 0.0_pReal
- if (present(ddot_gamma_dtau_tw)) ddot_gamma_dtau_tw(i) = 0.0_pReal
+ dot_gamma_tw(i) = 0.0_pREAL
+ if (present(ddot_gamma_dtau_tw)) ddot_gamma_dtau_tw(i) = 0.0_pREAL
end if
end do
@@ -986,21 +986,21 @@ end subroutine kinetics_tw
pure subroutine kinetics_tr(Mp,T,abs_dot_gamma_sl,ph,en,&
dot_gamma_tr,ddot_gamma_dtau_tr)
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
- real(pReal), intent(in) :: &
+ real(pREAL), intent(in) :: &
T !< temperature
integer, intent(in) :: &
ph, &
en
- real(pReal), dimension(param(ph)%sum_N_sl), intent(in) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl), intent(in) :: &
abs_dot_gamma_sl
- real(pReal), dimension(param(ph)%sum_N_tr), intent(out) :: &
+ real(pREAL), dimension(param(ph)%sum_N_tr), intent(out) :: &
dot_gamma_tr
- real(pReal), dimension(param(ph)%sum_N_tr), optional, intent(out) :: &
+ real(pREAL), dimension(param(ph)%sum_N_tr), optional, intent(out) :: &
ddot_gamma_dtau_tr
- real(pReal) :: &
+ real(pREAL) :: &
tau, tau_r, tau_hat, &
dot_N_0, &
x0, V, &
@@ -1019,10 +1019,10 @@ pure subroutine kinetics_tr(Mp,T,abs_dot_gamma_sl,ph,en,&
nu = elastic_nu(ph,en,prm%isotropic_bound)
Gamma_sf = prm%Gamma_sf%at(T)
- tau_hat = 3.0_pReal*prm%b_tr(1)*mu/prm%L_tr &
- + (Gamma_sf + (prm%h/prm%V_mol - 2.0_pReal*prm%rho)*prm%Delta_G%at(T))/(3.0_pReal*prm%b_tr(1))
- x0 = mu*prm%b_sl(1)**2*(2.0_pReal+nu)/(Gamma_sf*8.0_pReal*PI*(1.0_pReal-nu))
- tau_r = mu*prm%b_sl(1)/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%x_c)+cos(PI/3.0_pReal)/x0)
+ tau_hat = 3.0_pREAL*prm%b_tr(1)*mu/prm%L_tr &
+ + (Gamma_sf + (prm%h/prm%V_mol - 2.0_pREAL*prm%rho)*prm%Delta_G%at(T))/(3.0_pREAL*prm%b_tr(1))
+ x0 = mu*prm%b_sl(1)**2*(2.0_pREAL+nu)/(Gamma_sf*8.0_pREAL*PI*(1.0_pREAL-nu))
+ tau_r = mu*prm%b_sl(1)/(2.0_pREAL*PI)*(1.0_pREAL/(x0+prm%x_c)+cos(PI/3.0_pREAL)/x0)
do i = 1, prm%sum_N_tr
tau = math_tensordot(Mp,prm%P_tr(1:3,1:3,i))
@@ -1032,18 +1032,18 @@ pure subroutine kinetics_tr(Mp,T,abs_dot_gamma_sl,ph,en,&
dP_dTau = prm%s(i) * (tau_hat/tau)**prm%s(i)/tau * P
s = prm%fcc_twinNucleationSlipPair(1:2,i)
- dot_N_0 = sum(abs_dot_gamma_sl(s(2:1:-1))*(stt%rho_mob(s,en)+stt%rho_dip(s,en)))/(prm%L_tr*3.0_pReal)
+ dot_N_0 = sum(abs_dot_gamma_sl(s(2:1:-1))*(stt%rho_mob(s,en)+stt%rho_dip(s,en)))/(prm%L_tr*3.0_pREAL)
- P_ncs = 1.0_pReal-exp(-prm%V_cs/(K_B*T)*(tau_r-tau))
- dP_ncs_dtau = prm%V_cs / (K_B * T) * (P_ncs - 1.0_pReal)
+ P_ncs = 1.0_pREAL-exp(-prm%V_cs/(K_B*T)*(tau_r-tau))
+ dP_ncs_dtau = prm%V_cs / (K_B * T) * (P_ncs - 1.0_pREAL)
- V = PI/4.0_pReal*dst%Lambda_tr(i,en)**2*prm%t_tr(i)
+ V = PI/4.0_pREAL*dst%Lambda_tr(i,en)**2*prm%t_tr(i)
dot_gamma_tr(i) = V*dot_N_0*P_ncs*P*gamma_char_tr
if (present(ddot_gamma_dtau_tr)) &
ddot_gamma_dtau_tr(i) = V*dot_N_0*(P*dP_ncs_dtau + P_ncs*dP_dtau)*gamma_char_tr
else
- dot_gamma_tr(i) = 0.0_pReal
- if (present(ddot_gamma_dtau_tr)) ddot_gamma_dtau_tr(i) = 0.0_pReal
+ dot_gamma_tr(i) = 0.0_pREAL
+ if (present(ddot_gamma_dtau_tr)) ddot_gamma_dtau_tr(i) = 0.0_pREAL
end if
end do
diff --git a/src/phase_mechanical_plastic_isotropic.f90 b/src/phase_mechanical_plastic_isotropic.f90
index 7a94e6d8b..eff65f9f3 100644
--- a/src/phase_mechanical_plastic_isotropic.f90
+++ b/src/phase_mechanical_plastic_isotropic.f90
@@ -10,7 +10,7 @@
submodule(phase:plastic) isotropic
type :: tParameters
- real(pReal) :: &
+ real(pREAL) :: &
M, & !< Taylor factor
dot_gamma_0, & !< reference strain rate
n, & !< stress exponent
@@ -25,12 +25,12 @@ submodule(phase:plastic) isotropic
c_2
logical :: &
dilatation
- character(len=pStringLen), allocatable, dimension(:) :: &
+ character(len=pSTRLEN), allocatable, dimension(:) :: &
output
end type tParameters
type :: tIsotropicState
- real(pReal), pointer, dimension(:) :: &
+ real(pREAL), pointer, dimension(:) :: &
xi
end type tIsotropicState
@@ -52,7 +52,7 @@ module function plastic_isotropic_init() result(myPlasticity)
ph, &
Nmembers, &
sizeState, sizeDotState
- real(pReal) :: &
+ real(pREAL) :: &
xi_0 !< initial critical stress
character(len=:), allocatable :: &
refs, &
@@ -93,34 +93,34 @@ module function plastic_isotropic_init() result(myPlasticity)
if (len(refs) > 0) print'(/,1x,a)', refs
#if defined (__GFORTRAN__)
- prm%output = output_as1dString(pl)
+ prm%output = output_as1dStr(pl)
#else
- prm%output = pl%get_as1dString('output',defaultVal=emptyStringArray)
+ prm%output = pl%get_as1dStr('output',defaultVal=emptyStrArray)
#endif
- xi_0 = pl%get_asFloat('xi_0')
- prm%xi_inf = pl%get_asFloat('xi_inf')
- prm%dot_gamma_0 = pl%get_asFloat('dot_gamma_0')
- prm%n = pl%get_asFloat('n')
- prm%h_0 = pl%get_asFloat('h_0')
- prm%h = pl%get_asFloat('h', defaultVal=3.0_pReal) ! match for fcc random polycrystal
- prm%M = pl%get_asFloat('M')
- prm%h_ln = pl%get_asFloat('h_ln', defaultVal=0.0_pReal)
- prm%c_1 = pl%get_asFloat('c_1', defaultVal=0.0_pReal)
- prm%c_4 = pl%get_asFloat('c_4', defaultVal=0.0_pReal)
- prm%c_3 = pl%get_asFloat('c_3', defaultVal=0.0_pReal)
- prm%c_2 = pl%get_asFloat('c_2', defaultVal=0.0_pReal)
- prm%a = pl%get_asFloat('a')
+ xi_0 = pl%get_asReal('xi_0')
+ prm%xi_inf = pl%get_asReal('xi_inf')
+ prm%dot_gamma_0 = pl%get_asReal('dot_gamma_0')
+ prm%n = pl%get_asReal('n')
+ prm%h_0 = pl%get_asReal('h_0')
+ prm%h = pl%get_asReal('h', defaultVal=3.0_pREAL) ! match for fcc random polycrystal
+ prm%M = pl%get_asReal('M')
+ prm%h_ln = pl%get_asReal('h_ln', defaultVal=0.0_pREAL)
+ prm%c_1 = pl%get_asReal('c_1', defaultVal=0.0_pREAL)
+ prm%c_4 = pl%get_asReal('c_4', defaultVal=0.0_pREAL)
+ prm%c_3 = pl%get_asReal('c_3', defaultVal=0.0_pREAL)
+ prm%c_2 = pl%get_asReal('c_2', defaultVal=0.0_pREAL)
+ prm%a = pl%get_asReal('a')
prm%dilatation = pl%get_asBool('dilatation',defaultVal = .false.)
!--------------------------------------------------------------------------------------------------
! sanity checks
- if (xi_0 < 0.0_pReal) extmsg = trim(extmsg)//' xi_0'
- if (prm%dot_gamma_0 <= 0.0_pReal) extmsg = trim(extmsg)//' dot_gamma_0'
- if (prm%n <= 0.0_pReal) extmsg = trim(extmsg)//' n'
- if (prm%a <= 0.0_pReal) extmsg = trim(extmsg)//' a'
- if (prm%M <= 0.0_pReal) extmsg = trim(extmsg)//' M'
+ if (xi_0 < 0.0_pREAL) extmsg = trim(extmsg)//' xi_0'
+ if (prm%dot_gamma_0 <= 0.0_pREAL) extmsg = trim(extmsg)//' dot_gamma_0'
+ if (prm%n <= 0.0_pREAL) extmsg = trim(extmsg)//' n'
+ if (prm%a <= 0.0_pREAL) extmsg = trim(extmsg)//' a'
+ if (prm%M <= 0.0_pREAL) extmsg = trim(extmsg)//' M'
!--------------------------------------------------------------------------------------------------
! allocate state arrays
@@ -135,8 +135,8 @@ module function plastic_isotropic_init() result(myPlasticity)
! state aliases and initialization
stt%xi => plasticState(ph)%state(1,:)
stt%xi = xi_0
- plasticState(ph)%atol(1) = pl%get_asFloat('atol_xi',defaultVal=1.0_pReal)
- if (plasticState(ph)%atol(1) < 0.0_pReal) extmsg = trim(extmsg)//' atol_xi'
+ plasticState(ph)%atol(1) = pl%get_asReal('atol_xi',defaultVal=1.0_pREAL)
+ if (plasticState(ph)%atol(1) < 0.0_pREAL) extmsg = trim(extmsg)//' atol_xi'
end associate
@@ -154,20 +154,20 @@ end function plastic_isotropic_init
!--------------------------------------------------------------------------------------------------
module subroutine isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
- real(pReal), dimension(3,3), intent(out) :: &
+ real(pREAL), dimension(3,3), intent(out) :: &
Lp !< plastic velocity gradient
- real(pReal), dimension(3,3,3,3), intent(out) :: &
+ real(pREAL), dimension(3,3,3,3), intent(out) :: &
dLp_dMp !< derivative of Lp with respect to the Mandel stress
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer, intent(in) :: &
ph, &
en
- real(pReal), dimension(3,3) :: &
+ real(pREAL), dimension(3,3) :: &
Mp_dev !< deviatoric part of the Mandel stress
- real(pReal) :: &
+ real(pREAL) :: &
dot_gamma, & !< strainrate
norm_Mp_dev, & !< norm of the deviatoric part of the Mandel stress
squarenorm_Mp_dev !< square of the norm of the deviatoric part of the Mandel stress
@@ -181,20 +181,20 @@ module subroutine isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
squarenorm_Mp_dev = math_tensordot(Mp_dev,Mp_dev)
norm_Mp_dev = sqrt(squarenorm_Mp_dev)
- if (norm_Mp_dev > 0.0_pReal) then
- dot_gamma = prm%dot_gamma_0 * (sqrt(1.5_pReal) * norm_Mp_dev/(prm%M*stt%xi(en)))**prm%n
+ if (norm_Mp_dev > 0.0_pREAL) then
+ dot_gamma = prm%dot_gamma_0 * (sqrt(1.5_pREAL) * norm_Mp_dev/(prm%M*stt%xi(en)))**prm%n
Lp = dot_gamma * Mp_dev/norm_Mp_dev
forall (k=1:3,l=1:3,m=1:3,n=1:3) &
- dLp_dMp(k,l,m,n) = (prm%n-1.0_pReal) * Mp_dev(k,l)*Mp_dev(m,n) / squarenorm_Mp_dev
+ dLp_dMp(k,l,m,n) = (prm%n-1.0_pREAL) * Mp_dev(k,l)*Mp_dev(m,n) / squarenorm_Mp_dev
forall (k=1:3,l=1:3) &
- dLp_dMp(k,l,k,l) = dLp_dMp(k,l,k,l) + 1.0_pReal
+ dLp_dMp(k,l,k,l) = dLp_dMp(k,l,k,l) + 1.0_pREAL
forall (k=1:3,m=1:3) &
- dLp_dMp(k,k,m,m) = dLp_dMp(k,k,m,m) - 1.0_pReal/3.0_pReal
+ dLp_dMp(k,k,m,m) = dLp_dMp(k,k,m,m) - 1.0_pREAL/3.0_pREAL
dLp_dMp = dot_gamma * dLp_dMp / norm_Mp_dev
else
- Lp = 0.0_pReal
- dLp_dMp = 0.0_pReal
+ Lp = 0.0_pREAL
+ dLp_dMp = 0.0_pREAL
end if
end associate
@@ -207,18 +207,18 @@ end subroutine isotropic_LpAndItsTangent
!--------------------------------------------------------------------------------------------------
module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,ph,en)
- real(pReal), dimension(3,3), intent(out) :: &
+ real(pREAL), dimension(3,3), intent(out) :: &
Li !< inleastic velocity gradient
- real(pReal), dimension(3,3,3,3), intent(out) :: &
+ real(pREAL), dimension(3,3,3,3), intent(out) :: &
dLi_dMi !< derivative of Li with respect to Mandel stress
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mi !< Mandel stress
integer, intent(in) :: &
ph, &
en
- real(pReal) :: &
+ real(pREAL) :: &
tr !< trace of spherical part of Mandel stress (= 3 x pressure)
integer :: &
k, l, m, n
@@ -228,14 +228,14 @@ module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,ph,en)
tr=math_trace33(math_spherical33(Mi))
- if (prm%dilatation .and. abs(tr) > 0.0_pReal) then ! no stress or J2 plasticity --> Li and its derivative are zero
+ if (prm%dilatation .and. abs(tr) > 0.0_pREAL) then ! no stress or J2 plasticity --> Li and its derivative are zero
Li = math_I3 &
- * prm%dot_gamma_0 * (3.0_pReal*prm%M*stt%xi(en))**(-prm%n) &
- * tr * abs(tr)**(prm%n-1.0_pReal)
+ * prm%dot_gamma_0 * (3.0_pREAL*prm%M*stt%xi(en))**(-prm%n) &
+ * tr * abs(tr)**(prm%n-1.0_pREAL)
forall (k=1:3,l=1:3,m=1:3,n=1:3) dLi_dMi(k,l,m,n) = prm%n / tr * Li(k,l) * math_I3(m,n)
else
- Li = 0.0_pReal
- dLi_dMi = 0.0_pReal
+ Li = 0.0_pREAL
+ dLi_dMi = 0.0_pREAL
end if
end associate
@@ -248,15 +248,15 @@ module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,ph,en)
!--------------------------------------------------------------------------------------------------
module function isotropic_dotState(Mp,ph,en) result(dotState)
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer, intent(in) :: &
ph, &
en
- real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+ real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
dotState
- real(pReal) :: &
+ real(pREAL) :: &
dot_gamma, & !< strainrate
xi_inf_star, & !< saturation xi
norm_Mp !< norm of the (deviatoric) Mandel stress
@@ -267,21 +267,21 @@ module function isotropic_dotState(Mp,ph,en) result(dotState)
sqrt(math_tensordot(math_deviatoric33(Mp),math_deviatoric33(Mp))), &
prm%dilatation)
- dot_gamma = prm%dot_gamma_0 * (sqrt(1.5_pReal) * norm_Mp /(prm%M*stt%xi(en))) **prm%n
+ dot_gamma = prm%dot_gamma_0 * (sqrt(1.5_pREAL) * norm_Mp /(prm%M*stt%xi(en))) **prm%n
- if (dot_gamma > 1e-12_pReal) then
+ if (dot_gamma > 1e-12_pREAL) then
if (dEq0(prm%c_1)) then
xi_inf_star = prm%xi_inf
else
xi_inf_star = prm%xi_inf &
- + asinh( (dot_gamma / prm%c_1)**(1.0_pReal / prm%c_2))**(1.0_pReal / prm%c_3) &
- / prm%c_4 * (dot_gamma / prm%dot_gamma_0)**(1.0_pReal / prm%n)
+ + asinh( (dot_gamma / prm%c_1)**(1.0_pREAL / prm%c_2))**(1.0_pREAL / prm%c_3) &
+ / prm%c_4 * (dot_gamma / prm%dot_gamma_0)**(1.0_pREAL / prm%n)
end if
dot_xi = dot_gamma &
* ( prm%h_0 + prm%h_ln * log(dot_gamma) ) &
- * sign(abs(1.0_pReal - stt%xi(en)/xi_inf_star)**prm%a *prm%h, 1.0_pReal-stt%xi(en)/xi_inf_star)
+ * sign(abs(1.0_pREAL - stt%xi(en)/xi_inf_star)**prm%a *prm%h, 1.0_pREAL-stt%xi(en)/xi_inf_star)
else
- dot_xi = 0.0_pReal
+ dot_xi = 0.0_pREAL
end if
end associate
diff --git a/src/phase_mechanical_plastic_kinehardening.f90 b/src/phase_mechanical_plastic_kinehardening.f90
index 390d5c7c8..ad2543b83 100644
--- a/src/phase_mechanical_plastic_kinehardening.f90
+++ b/src/phase_mechanical_plastic_kinehardening.f90
@@ -8,10 +8,10 @@
submodule(phase:plastic) kinehardening
type :: tParameters
- real(pReal) :: &
- n = 1.0_pReal, & !< stress exponent for slip
- dot_gamma_0 = 1.0_pReal !< reference shear strain rate for slip
- real(pReal), allocatable, dimension(:) :: &
+ real(pREAL) :: &
+ n = 1.0_pREAL, & !< stress exponent for slip
+ dot_gamma_0 = 1.0_pREAL !< reference shear strain rate for slip
+ real(pREAL), allocatable, dimension(:) :: &
h_0_xi, & !< initial hardening rate of forest stress per slip family
!! θ_0,for
h_0_chi, & !< initial hardening rate of back stress per slip family
@@ -22,9 +22,9 @@ submodule(phase:plastic) kinehardening
!! θ_1,bs
xi_inf, & !< back-extrapolated forest stress from terminal linear hardening
chi_inf !< back-extrapolated back stress from terminal linear hardening
- real(pReal), allocatable, dimension(:,:) :: &
+ real(pREAL), allocatable, dimension(:,:) :: &
h_sl_sl !< slip resistance change per slip activity
- real(pReal), allocatable, dimension(:,:,:) :: &
+ real(pREAL), allocatable, dimension(:,:,:) :: &
P, &
P_nS_pos, &
P_nS_neg
@@ -32,9 +32,9 @@ submodule(phase:plastic) kinehardening
sum_N_sl
logical :: &
nonSchmidActive = .false.
- character(len=pStringLen), allocatable, dimension(:) :: &
+ character(len=pSTRLEN), allocatable, dimension(:) :: &
output
- character(len=:), allocatable, dimension(:) :: &
+ character(len=:), allocatable, dimension(:) :: &
systems_sl
end type tParameters
@@ -46,7 +46,7 @@ submodule(phase:plastic) kinehardening
end type tIndexDotState
type :: tKinehardeningState
- real(pReal), pointer, dimension(:,:) :: &
+ real(pREAL), pointer, dimension(:,:) :: &
xi, & !< forest stress
!! τ_for
chi, & !< back stress
@@ -82,7 +82,7 @@ module function plastic_kinehardening_init() result(myPlasticity)
startIndex, endIndex
integer, dimension(:), allocatable :: &
N_sl
- real(pReal), dimension(:), allocatable :: &
+ real(pREAL), dimension(:), allocatable :: &
xi_0, & !< initial forest stress
!! τ_for,0
a !< non-Schmid coefficients
@@ -128,9 +128,9 @@ module function plastic_kinehardening_init() result(myPlasticity)
if (len(refs) > 0) print'(/,1x,a)', refs
#if defined (__GFORTRAN__)
- prm%output = output_as1dString(pl)
+ prm%output = output_as1dStr(pl)
#else
- prm%output = pl%get_as1dString('output',defaultVal=emptyStringArray)
+ prm%output = pl%get_as1dStr('output',defaultVal=emptyStrArray)
#endif
!--------------------------------------------------------------------------------------------------
@@ -142,7 +142,7 @@ module function plastic_kinehardening_init() result(myPlasticity)
prm%P = lattice_SchmidMatrix_slip(N_sl,phase_lattice(ph),phase_cOverA(ph))
if (phase_lattice(ph) == 'cI') then
- a = pl%get_as1dFloat('a_nonSchmid',defaultVal=emptyRealArray)
+ a = pl%get_as1dReal('a_nonSchmid',defaultVal=emptyRealArray)
prm%nonSchmidActive = size(a) > 0
prm%P_nS_pos = lattice_nonSchmidMatrix(N_sl,a,+1)
prm%P_nS_neg = lattice_nonSchmidMatrix(N_sl,a,-1)
@@ -150,19 +150,19 @@ module function plastic_kinehardening_init() result(myPlasticity)
prm%P_nS_pos = prm%P
prm%P_nS_neg = prm%P
end if
- prm%h_sl_sl = lattice_interaction_SlipBySlip(N_sl,pl%get_as1dFloat('h_sl-sl'), &
+ prm%h_sl_sl = lattice_interaction_SlipBySlip(N_sl,pl%get_as1dReal('h_sl-sl'), &
phase_lattice(ph))
- xi_0 = pl%get_as1dFloat('xi_0', requiredSize=size(N_sl))
- prm%xi_inf = pl%get_as1dFloat('xi_inf', requiredSize=size(N_sl))
- prm%chi_inf = pl%get_as1dFloat('chi_inf', requiredSize=size(N_sl))
- prm%h_0_xi = pl%get_as1dFloat('h_0_xi', requiredSize=size(N_sl))
- prm%h_0_chi = pl%get_as1dFloat('h_0_chi', requiredSize=size(N_sl))
- prm%h_inf_xi = pl%get_as1dFloat('h_inf_xi', requiredSize=size(N_sl))
- prm%h_inf_chi = pl%get_as1dFloat('h_inf_chi', requiredSize=size(N_sl))
+ xi_0 = pl%get_as1dReal('xi_0', requiredSize=size(N_sl))
+ prm%xi_inf = pl%get_as1dReal('xi_inf', requiredSize=size(N_sl))
+ prm%chi_inf = pl%get_as1dReal('chi_inf', requiredSize=size(N_sl))
+ prm%h_0_xi = pl%get_as1dReal('h_0_xi', requiredSize=size(N_sl))
+ prm%h_0_chi = pl%get_as1dReal('h_0_chi', requiredSize=size(N_sl))
+ prm%h_inf_xi = pl%get_as1dReal('h_inf_xi', requiredSize=size(N_sl))
+ prm%h_inf_chi = pl%get_as1dReal('h_inf_chi', requiredSize=size(N_sl))
- prm%dot_gamma_0 = pl%get_asFloat('dot_gamma_0')
- prm%n = pl%get_asFloat('n')
+ prm%dot_gamma_0 = pl%get_asReal('dot_gamma_0')
+ prm%n = pl%get_asReal('n')
! expand: family => system
xi_0 = math_expand(xi_0, N_sl)
@@ -175,11 +175,11 @@ module function plastic_kinehardening_init() result(myPlasticity)
!--------------------------------------------------------------------------------------------------
! sanity checks
- if ( prm%dot_gamma_0 <= 0.0_pReal) extmsg = trim(extmsg)//' dot_gamma_0'
- if ( prm%n <= 0.0_pReal) extmsg = trim(extmsg)//' n'
- if (any(xi_0 <= 0.0_pReal)) extmsg = trim(extmsg)//' xi_0'
- if (any(prm%xi_inf <= 0.0_pReal)) extmsg = trim(extmsg)//' xi_inf'
- if (any(prm%chi_inf <= 0.0_pReal)) extmsg = trim(extmsg)//' chi_inf'
+ if ( prm%dot_gamma_0 <= 0.0_pREAL) extmsg = trim(extmsg)//' dot_gamma_0'
+ if ( prm%n <= 0.0_pREAL) extmsg = trim(extmsg)//' n'
+ if (any(xi_0 <= 0.0_pREAL)) extmsg = trim(extmsg)//' xi_0'
+ if (any(prm%xi_inf <= 0.0_pREAL)) extmsg = trim(extmsg)//' xi_inf'
+ if (any(prm%chi_inf <= 0.0_pREAL)) extmsg = trim(extmsg)//' chi_inf'
else slipActive
xi_0 = emptyRealArray
@@ -208,21 +208,21 @@ module function plastic_kinehardening_init() result(myPlasticity)
idx_dot%xi = [startIndex,endIndex]
stt%xi => plasticState(ph)%state(startIndex:endIndex,:)
stt%xi = spread(xi_0, 2, Nmembers)
- plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_xi',defaultVal=1.0_pReal)
- if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_xi'
+ plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_xi',defaultVal=1.0_pREAL)
+ if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pREAL)) extmsg = trim(extmsg)//' atol_xi'
startIndex = endIndex + 1
endIndex = endIndex + prm%sum_N_sl
idx_dot%chi = [startIndex,endIndex]
stt%chi => plasticState(ph)%state(startIndex:endIndex,:)
- plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_xi',defaultVal=1.0_pReal)
+ plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_xi',defaultVal=1.0_pREAL)
startIndex = endIndex + 1
endIndex = endIndex + prm%sum_N_sl
idx_dot%gamma = [startIndex,endIndex]
stt%gamma => plasticState(ph)%state(startIndex:endIndex,:)
- plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_gamma',defaultVal=1.0e-6_pReal)
- if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_gamma'
+ plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_gamma',defaultVal=1.0e-6_pREAL)
+ if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pREAL)) extmsg = trim(extmsg)//' atol_gamma'
o = plasticState(ph)%offsetDeltaState
startIndex = endIndex + 1
@@ -257,12 +257,12 @@ end function plastic_kinehardening_init
!--------------------------------------------------------------------------------------------------
pure module subroutine kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
- real(pReal), dimension(3,3), intent(out) :: &
+ real(pREAL), dimension(3,3), intent(out) :: &
Lp !< plastic velocity gradient
- real(pReal), dimension(3,3,3,3), intent(out) :: &
+ real(pREAL), dimension(3,3,3,3), intent(out) :: &
dLp_dMp !< derivative of Lp with respect to the Mandel stress
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer, intent(in) :: &
ph, &
@@ -270,12 +270,12 @@ pure module subroutine kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
integer :: &
i,k,l,m,n
- real(pReal), dimension(param(ph)%sum_N_sl) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl) :: &
dot_gamma_pos,dot_gamma_neg, &
ddot_gamma_dtau_pos,ddot_gamma_dtau_neg
- Lp = 0.0_pReal
- dLp_dMp = 0.0_pReal
+ Lp = 0.0_pREAL
+ dLp_dMp = 0.0_pREAL
associate(prm => param(ph))
@@ -299,17 +299,17 @@ end subroutine kinehardening_LpAndItsTangent
!--------------------------------------------------------------------------------------------------
module function plastic_kinehardening_dotState(Mp,ph,en) result(dotState)
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer, intent(in) :: &
ph, &
en
- real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+ real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
dotState
- real(pReal) :: &
+ real(pREAL) :: &
sumGamma
- real(pReal), dimension(param(ph)%sum_N_sl) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl) :: &
dot_gamma_pos,dot_gamma_neg
@@ -326,14 +326,14 @@ module function plastic_kinehardening_dotState(Mp,ph,en) result(dotState)
dot_xi = matmul(prm%h_sl_sl,dot_gamma) &
* ( prm%h_inf_xi &
+ ( prm%h_0_xi &
- - prm%h_inf_xi * (1_pReal -sumGamma*prm%h_0_xi/prm%xi_inf) ) &
+ - prm%h_inf_xi * (1_pREAL -sumGamma*prm%h_0_xi/prm%xi_inf) ) &
* exp(-sumGamma*prm%h_0_xi/prm%xi_inf) &
)
dot_chi = stt%sgn_gamma(:,en)*dot_gamma &
* ( prm%h_inf_chi &
+ ( prm%h_0_chi &
- - prm%h_inf_chi*(1_pReal -(stt%gamma(:,en)-stt%gamma_flip(:,en))*prm%h_0_chi/(prm%chi_inf+stt%chi_flip(:,en))) ) &
+ - prm%h_inf_chi*(1_pREAL -(stt%gamma(:,en)-stt%gamma_flip(:,en))*prm%h_0_chi/(prm%chi_inf+stt%chi_flip(:,en))) ) &
* exp(-(stt%gamma(:,en)-stt%gamma_flip(:,en))*prm%h_0_chi/(prm%chi_inf+stt%chi_flip(:,en))) &
)
@@ -347,13 +347,13 @@ end function plastic_kinehardening_dotState
!--------------------------------------------------------------------------------------------------
module subroutine plastic_kinehardening_deltaState(Mp,ph,en)
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer, intent(in) :: &
ph, &
en
- real(pReal), dimension(param(ph)%sum_N_sl) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl) :: &
dot_gamma_pos,dot_gamma_neg, &
sgn_gamma
@@ -362,17 +362,17 @@ module subroutine plastic_kinehardening_deltaState(Mp,ph,en)
call kinetics(Mp,ph,en, dot_gamma_pos,dot_gamma_neg)
sgn_gamma = merge(state(ph)%sgn_gamma(:,en), &
- sign(1.0_pReal,dot_gamma_pos+dot_gamma_neg), &
- dEq0(dot_gamma_pos+dot_gamma_neg,1e-10_pReal))
+ sign(1.0_pREAL,dot_gamma_pos+dot_gamma_neg), &
+ dEq0(dot_gamma_pos+dot_gamma_neg,1e-10_pREAL))
- where(dNeq(sgn_gamma,stt%sgn_gamma(:,en),0.1_pReal)) ! ToDo sgn_gamma*stt%sgn_gamma(:,en)<0
+ where(dNeq(sgn_gamma,stt%sgn_gamma(:,en),0.1_pREAL)) ! ToDo sgn_gamma*stt%sgn_gamma(:,en)<0
dlt%sgn_gamma (:,en) = sgn_gamma - stt%sgn_gamma (:,en)
dlt%chi_flip (:,en) = abs(stt%chi (:,en)) - stt%chi_flip (:,en)
dlt%gamma_flip(:,en) = stt%gamma(:,en) - stt%gamma_flip(:,en)
else where
- dlt%sgn_gamma (:,en) = 0.0_pReal
- dlt%chi_flip (:,en) = 0.0_pReal
- dlt%gamma_flip(:,en) = 0.0_pReal
+ dlt%sgn_gamma (:,en) = 0.0_pREAL
+ dlt%chi_flip (:,en) = 0.0_pREAL
+ dlt%gamma_flip(:,en) = 0.0_pREAL
end where
end associate
@@ -434,20 +434,20 @@ end subroutine plastic_kinehardening_result
pure subroutine kinetics(Mp,ph,en, &
dot_gamma_pos,dot_gamma_neg,ddot_gamma_dtau_pos,ddot_gamma_dtau_neg)
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer, intent(in) :: &
ph, &
en
- real(pReal), intent(out), dimension(param(ph)%sum_N_sl) :: &
+ real(pREAL), intent(out), dimension(param(ph)%sum_N_sl) :: &
dot_gamma_pos, &
dot_gamma_neg
- real(pReal), intent(out), dimension(param(ph)%sum_N_sl), optional :: &
+ real(pREAL), intent(out), dimension(param(ph)%sum_N_sl), optional :: &
ddot_gamma_dtau_pos, &
ddot_gamma_dtau_neg
- real(pReal), dimension(param(ph)%sum_N_sl) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl) :: &
tau_pos, &
tau_neg
integer :: i
@@ -458,35 +458,35 @@ pure subroutine kinetics(Mp,ph,en, &
do i = 1, prm%sum_N_sl
tau_pos(i) = math_tensordot(Mp,prm%P_nS_pos(1:3,1:3,i)) - stt%chi(i,en)
tau_neg(i) = merge(math_tensordot(Mp,prm%P_nS_neg(1:3,1:3,i)) - stt%chi(i,en), &
- 0.0_pReal, prm%nonSchmidActive)
+ 0.0_pREAL, prm%nonSchmidActive)
end do
where(dNeq0(tau_pos))
- dot_gamma_pos = prm%dot_gamma_0 * merge(0.5_pReal,1.0_pReal, prm%nonSchmidActive) & ! 1/2 if non-Schmid active
+ dot_gamma_pos = prm%dot_gamma_0 * merge(0.5_pREAL,1.0_pREAL, prm%nonSchmidActive) & ! 1/2 if non-Schmid active
* sign(abs(tau_pos/stt%xi(:,en))**prm%n, tau_pos)
else where
- dot_gamma_pos = 0.0_pReal
+ dot_gamma_pos = 0.0_pREAL
end where
where(dNeq0(tau_neg))
- dot_gamma_neg = prm%dot_gamma_0 * 0.5_pReal & ! only used if non-Schmid active, always 1/2
+ dot_gamma_neg = prm%dot_gamma_0 * 0.5_pREAL & ! only used if non-Schmid active, always 1/2
* sign(abs(tau_neg/stt%xi(:,en))**prm%n, tau_neg)
else where
- dot_gamma_neg = 0.0_pReal
+ dot_gamma_neg = 0.0_pREAL
end where
if (present(ddot_gamma_dtau_pos)) then
where(dNeq0(dot_gamma_pos))
ddot_gamma_dtau_pos = dot_gamma_pos*prm%n/tau_pos
else where
- ddot_gamma_dtau_pos = 0.0_pReal
+ ddot_gamma_dtau_pos = 0.0_pREAL
end where
end if
if (present(ddot_gamma_dtau_neg)) then
where(dNeq0(dot_gamma_neg))
ddot_gamma_dtau_neg = dot_gamma_neg*prm%n/tau_neg
else where
- ddot_gamma_dtau_neg = 0.0_pReal
+ ddot_gamma_dtau_neg = 0.0_pREAL
end where
end if
diff --git a/src/phase_mechanical_plastic_nonlocal.f90 b/src/phase_mechanical_plastic_nonlocal.f90
index aeb647eeb..d50f562ca 100644
--- a/src/phase_mechanical_plastic_nonlocal.f90
+++ b/src/phase_mechanical_plastic_nonlocal.f90
@@ -14,10 +14,10 @@ submodule(phase:plastic) nonlocal
geometry_plastic_nonlocal_disable
type :: tGeometry
- real(pReal), dimension(:), allocatable :: V_0
+ real(pREAL), dimension(:), allocatable :: V_0
integer, dimension(:,:,:), allocatable :: IPneighborhood
- real(pReal), dimension(:,:), allocatable :: IParea, IPcoordinates
- real(pReal), dimension(:,:,:), allocatable :: IPareaNormal
+ real(pREAL), dimension(:,:), allocatable :: IParea, IPcoordinates
+ real(pREAL), dimension(:,:,:), allocatable :: IPareaNormal
end type tGeometry
type(tGeometry), dimension(:), allocatable :: geom
@@ -48,15 +48,15 @@ submodule(phase:plastic) nonlocal
iD !< state indices for stable dipole height
!END DEPRECATED
- real(pReal), dimension(:,:,:,:,:,:), allocatable :: &
+ real(pREAL), dimension(:,:,:,:,:,:), allocatable :: &
compatibility !< slip system compatibility between en and my neighbors
type :: tInitialParameters !< container type for internal constitutive parameters
- real(pReal) :: &
+ real(pREAL) :: &
sigma_rho_u, & !< standard deviation of scatter in initial dislocation density
random_rho_u, &
random_rho_u_binning
- real(pReal), dimension(:), allocatable :: &
+ real(pREAL), dimension(:), allocatable :: &
rho_u_ed_pos_0, & !< initial edge_pos dislocation density
rho_u_ed_neg_0, & !< initial edge_neg dislocation density
rho_u_sc_pos_0, & !< initial screw_pos dislocation density
@@ -68,7 +68,7 @@ submodule(phase:plastic) nonlocal
end type tInitialParameters
type :: tParameters !< container type for internal constitutive parameters
- real(pReal) :: &
+ real(pREAL) :: &
V_at, & !< atomic volume
D_0, & !< prefactor for self-diffusion coefficient
Q_cl, & !< activation enthalpy for diffusion
@@ -91,14 +91,14 @@ submodule(phase:plastic) nonlocal
f_ed, &
mu, &
nu
- real(pReal), dimension(:), allocatable :: &
+ real(pREAL), dimension(:), allocatable :: &
d_ed, & !< minimum stable edge dipole height
d_sc, & !< minimum stable screw dipole height
tau_Peierls_ed, &
tau_Peierls_sc, &
i_sl, & !< mean free path prefactor for each
b_sl !< absolute length of Burgers vector [m]
- real(pReal), dimension(:,:), allocatable :: &
+ real(pREAL), dimension(:,:), allocatable :: &
slip_normal, &
slip_direction, &
slip_transverse, &
@@ -107,7 +107,7 @@ submodule(phase:plastic) nonlocal
h_sl_sl ,& !< coefficients for slip-slip interaction
forestProjection_Edge, & !< matrix of forest projections of edge dislocations
forestProjection_Screw !< matrix of forest projections of screw dislocations
- real(pReal), dimension(:,:,:), allocatable :: &
+ real(pREAL), dimension(:,:,:), allocatable :: &
P_sl, & !< Schmid contribution
P_nS_pos, &
P_nS_neg !< combined projection of Schmid and non-Schmid contributions to the resolved shear stress (only for screws)
@@ -117,7 +117,7 @@ submodule(phase:plastic) nonlocal
colinearSystem !< colinear system to the active slip system (only valid for fcc!)
character(len=:), allocatable :: &
isotropic_bound
- character(len=pStringLen), dimension(:), allocatable :: &
+ character(len=pSTRLEN), dimension(:), allocatable :: &
output
logical :: &
shortRangeStressCorrection, & !< use of short range stress correction by excess density gradient term
@@ -127,15 +127,15 @@ submodule(phase:plastic) nonlocal
end type tParameters
type :: tNonlocalDependentState
- real(pReal), allocatable, dimension(:,:) :: &
+ real(pREAL), allocatable, dimension(:,:) :: &
tau_pass, &
tau_Back
- real(pReal), allocatable, dimension(:,:,:,:,:) :: &
+ real(pREAL), allocatable, dimension(:,:,:,:,:) :: &
compatibility
end type tNonlocalDependentState
type :: tNonlocalState
- real(pReal), pointer, dimension(:,:) :: &
+ real(pREAL), pointer, dimension(:,:) :: &
rho, & ! < all dislocations
rhoSgl, &
rhoSglMobile, & ! iRhoU
@@ -186,7 +186,7 @@ module function plastic_nonlocal_init() result(myPlasticity)
sizeState, sizeDotState, sizeDependentState, sizeDeltaState, &
s1, s2, &
s, t, l
- real(pReal), dimension(:), allocatable :: &
+ real(pREAL), dimension(:), allocatable :: &
a
character(len=:), allocatable :: &
refs, &
@@ -241,14 +241,14 @@ module function plastic_nonlocal_init() result(myPlasticity)
if (len(refs) > 0) print'(/,1x,a)', refs
#if defined (__GFORTRAN__)
- prm%output = output_as1dString(pl)
+ prm%output = output_as1dStr(pl)
#else
- prm%output = pl%get_as1dString('output',defaultVal=emptyStringArray)
+ prm%output = pl%get_as1dStr('output',defaultVal=emptyStrArray)
#endif
plasticState(ph)%nonlocal = pl%get_asBool('flux',defaultVal=.True.)
- prm%isotropic_bound = pl%get_asString('isotropic_bound',defaultVal='isostrain')
- prm%atol_rho = pl%get_asFloat('atol_rho',defaultVal=1.0_pReal)
+ prm%isotropic_bound = pl%get_asStr('isotropic_bound',defaultVal='isostrain')
+ prm%atol_rho = pl%get_asReal('atol_rho',defaultVal=1.0_pREAL)
ini%N_sl = pl%get_as1dInt('N_sl',defaultVal=emptyIntArray)
prm%sum_N_sl = sum(abs(ini%N_sl))
@@ -257,7 +257,7 @@ module function plastic_nonlocal_init() result(myPlasticity)
prm%P_sl = lattice_SchmidMatrix_slip(ini%N_sl,phase_lattice(ph), phase_cOverA(ph))
if (phase_lattice(ph) == 'cI') then
- a = pl%get_as1dFloat('a_nonSchmid',defaultVal = emptyRealArray)
+ a = pl%get_as1dReal('a_nonSchmid',defaultVal = emptyRealArray)
if (size(a) > 0) prm%nonSchmidActive = .true.
prm%P_nS_pos = lattice_nonSchmidMatrix(ini%N_sl,a,+1)
prm%P_nS_neg = lattice_nonSchmidMatrix(ini%N_sl,a,-1)
@@ -266,7 +266,7 @@ module function plastic_nonlocal_init() result(myPlasticity)
prm%P_nS_neg = prm%P_sl
end if
- prm%h_sl_sl = lattice_interaction_SlipBySlip(ini%N_sl,pl%get_as1dFloat('h_sl-sl'), &
+ prm%h_sl_sl = lattice_interaction_SlipBySlip(ini%N_sl,pl%get_as1dReal('h_sl-sl'), &
phase_lattice(ph))
prm%forestProjection_edge = lattice_forestProjection_edge (ini%N_sl,phase_lattice(ph),&
@@ -288,112 +288,112 @@ module function plastic_nonlocal_init() result(myPlasticity)
end do
end do
- ini%rho_u_ed_pos_0 = pl%get_as1dFloat('rho_u_ed_pos_0', requiredSize=size(ini%N_sl))
- ini%rho_u_ed_neg_0 = pl%get_as1dFloat('rho_u_ed_neg_0', requiredSize=size(ini%N_sl))
- ini%rho_u_sc_pos_0 = pl%get_as1dFloat('rho_u_sc_pos_0', requiredSize=size(ini%N_sl))
- ini%rho_u_sc_neg_0 = pl%get_as1dFloat('rho_u_sc_neg_0', requiredSize=size(ini%N_sl))
- ini%rho_d_ed_0 = pl%get_as1dFloat('rho_d_ed_0', requiredSize=size(ini%N_sl))
- ini%rho_d_sc_0 = pl%get_as1dFloat('rho_d_sc_0', requiredSize=size(ini%N_sl))
+ ini%rho_u_ed_pos_0 = pl%get_as1dReal('rho_u_ed_pos_0', requiredSize=size(ini%N_sl))
+ ini%rho_u_ed_neg_0 = pl%get_as1dReal('rho_u_ed_neg_0', requiredSize=size(ini%N_sl))
+ ini%rho_u_sc_pos_0 = pl%get_as1dReal('rho_u_sc_pos_0', requiredSize=size(ini%N_sl))
+ ini%rho_u_sc_neg_0 = pl%get_as1dReal('rho_u_sc_neg_0', requiredSize=size(ini%N_sl))
+ ini%rho_d_ed_0 = pl%get_as1dReal('rho_d_ed_0', requiredSize=size(ini%N_sl))
+ ini%rho_d_sc_0 = pl%get_as1dReal('rho_d_sc_0', requiredSize=size(ini%N_sl))
- prm%i_sl = pl%get_as1dFloat('i_sl', requiredSize=size(ini%N_sl))
- prm%b_sl = pl%get_as1dFloat('b_sl', requiredSize=size(ini%N_sl))
+ prm%i_sl = pl%get_as1dReal('i_sl', requiredSize=size(ini%N_sl))
+ prm%b_sl = pl%get_as1dReal('b_sl', requiredSize=size(ini%N_sl))
prm%i_sl = math_expand(prm%i_sl,ini%N_sl)
prm%b_sl = math_expand(prm%b_sl,ini%N_sl)
- prm%d_ed = pl%get_as1dFloat('d_ed', requiredSize=size(ini%N_sl))
- prm%d_sc = pl%get_as1dFloat('d_sc', requiredSize=size(ini%N_sl))
+ prm%d_ed = pl%get_as1dReal('d_ed', requiredSize=size(ini%N_sl))
+ prm%d_sc = pl%get_as1dReal('d_sc', requiredSize=size(ini%N_sl))
prm%d_ed = math_expand(prm%d_ed,ini%N_sl)
prm%d_sc = math_expand(prm%d_sc,ini%N_sl)
allocate(prm%minDipoleHeight(prm%sum_N_sl,2))
prm%minDipoleHeight(:,1) = prm%d_ed
prm%minDipoleHeight(:,2) = prm%d_sc
- prm%tau_Peierls_ed = pl%get_as1dFloat('tau_Peierls_ed', requiredSize=size(ini%N_sl))
- prm%tau_Peierls_sc = pl%get_as1dFloat('tau_Peierls_sc', requiredSize=size(ini%N_sl))
+ prm%tau_Peierls_ed = pl%get_as1dReal('tau_Peierls_ed', requiredSize=size(ini%N_sl))
+ prm%tau_Peierls_sc = pl%get_as1dReal('tau_Peierls_sc', requiredSize=size(ini%N_sl))
prm%tau_Peierls_ed = math_expand(prm%tau_Peierls_ed,ini%N_sl)
prm%tau_Peierls_sc = math_expand(prm%tau_Peierls_sc,ini%N_sl)
allocate(prm%peierlsstress(prm%sum_N_sl,2))
prm%peierlsstress(:,1) = prm%tau_Peierls_ed
prm%peierlsstress(:,2) = prm%tau_Peierls_sc
- prm%rho_significant = pl%get_asFloat('rho_significant')
- prm%rho_min = pl%get_asFloat('rho_min', 0.0_pReal)
- prm%C_CFL = pl%get_asFloat('C_CFL',defaultVal=2.0_pReal)
+ prm%rho_significant = pl%get_asReal('rho_significant')
+ prm%rho_min = pl%get_asReal('rho_min', 0.0_pREAL)
+ prm%C_CFL = pl%get_asReal('C_CFL',defaultVal=2.0_pREAL)
- prm%V_at = pl%get_asFloat('V_at')
- prm%D_0 = pl%get_asFloat('D_0')
- prm%Q_cl = pl%get_asFloat('Q_cl')
- prm%f_F = pl%get_asFloat('f_F')
- prm%f_ed = pl%get_asFloat('f_ed')
- prm%w = pl%get_asFloat('w')
- prm%Q_sol = pl%get_asFloat('Q_sol')
- prm%f_sol = pl%get_asFloat('f_sol')
- prm%c_sol = pl%get_asFloat('c_sol')
+ prm%V_at = pl%get_asReal('V_at')
+ prm%D_0 = pl%get_asReal('D_0')
+ prm%Q_cl = pl%get_asReal('Q_cl')
+ prm%f_F = pl%get_asReal('f_F')
+ prm%f_ed = pl%get_asReal('f_ed')
+ prm%w = pl%get_asReal('w')
+ prm%Q_sol = pl%get_asReal('Q_sol')
+ prm%f_sol = pl%get_asReal('f_sol')
+ prm%c_sol = pl%get_asReal('c_sol')
- prm%p = pl%get_asFloat('p_sl')
- prm%q = pl%get_asFloat('q_sl')
- prm%B = pl%get_asFloat('B')
- prm%nu_a = pl%get_asFloat('nu_a')
+ prm%p = pl%get_asReal('p_sl')
+ prm%q = pl%get_asReal('q_sl')
+ prm%B = pl%get_asReal('B')
+ prm%nu_a = pl%get_asReal('nu_a')
! ToDo: discuss logic
- ini%sigma_rho_u = pl%get_asFloat('sigma_rho_u')
- ini%random_rho_u = pl%get_asFloat('random_rho_u',defaultVal= 0.0_pReal)
+ ini%sigma_rho_u = pl%get_asReal('sigma_rho_u')
+ ini%random_rho_u = pl%get_asReal('random_rho_u',defaultVal= 0.0_pREAL)
if (pl%contains('random_rho_u')) &
- ini%random_rho_u_binning = pl%get_asFloat('random_rho_u_binning',defaultVal=0.0_pReal) !ToDo: useful default?
- ! if (rhoSglRandom(instance) < 0.0_pReal) &
- ! if (rhoSglRandomBinning(instance) <= 0.0_pReal) &
+ ini%random_rho_u_binning = pl%get_asReal('random_rho_u_binning',defaultVal=0.0_pREAL) !ToDo: useful default?
+ ! if (rhoSglRandom(instance) < 0.0_pREAL) &
+ ! if (rhoSglRandomBinning(instance) <= 0.0_pREAL) &
- prm%chi_surface = pl%get_asFloat('chi_surface',defaultVal=1.0_pReal)
- prm%chi_GB = pl%get_asFloat('chi_GB', defaultVal=-1.0_pReal)
- prm%f_ed_mult = pl%get_asFloat('f_ed_mult')
+ prm%chi_surface = pl%get_asReal('chi_surface',defaultVal=1.0_pREAL)
+ prm%chi_GB = pl%get_asReal('chi_GB', defaultVal=-1.0_pREAL)
+ prm%f_ed_mult = pl%get_asReal('f_ed_mult')
prm%shortRangeStressCorrection = pl%get_asBool('short_range_stress_correction', defaultVal = .false.)
!--------------------------------------------------------------------------------------------------
! sanity checks
- if (any(prm%b_sl < 0.0_pReal)) extmsg = trim(extmsg)//' b_sl'
- if (any(prm%i_sl <= 0.0_pReal)) extmsg = trim(extmsg)//' i_sl'
+ if (any(prm%b_sl < 0.0_pREAL)) extmsg = trim(extmsg)//' b_sl'
+ if (any(prm%i_sl <= 0.0_pREAL)) extmsg = trim(extmsg)//' i_sl'
- if (any(ini%rho_u_ed_pos_0 < 0.0_pReal)) extmsg = trim(extmsg)//' rho_u_ed_pos_0'
- if (any(ini%rho_u_ed_neg_0 < 0.0_pReal)) extmsg = trim(extmsg)//' rho_u_ed_neg_0'
- if (any(ini%rho_u_sc_pos_0 < 0.0_pReal)) extmsg = trim(extmsg)//' rho_u_sc_pos_0'
- if (any(ini%rho_u_sc_neg_0 < 0.0_pReal)) extmsg = trim(extmsg)//' rho_u_sc_neg_0'
- if (any(ini%rho_d_ed_0 < 0.0_pReal)) extmsg = trim(extmsg)//' rho_d_ed_0'
- if (any(ini%rho_d_sc_0 < 0.0_pReal)) extmsg = trim(extmsg)//' rho_d_sc_0'
+ if (any(ini%rho_u_ed_pos_0 < 0.0_pREAL)) extmsg = trim(extmsg)//' rho_u_ed_pos_0'
+ if (any(ini%rho_u_ed_neg_0 < 0.0_pREAL)) extmsg = trim(extmsg)//' rho_u_ed_neg_0'
+ if (any(ini%rho_u_sc_pos_0 < 0.0_pREAL)) extmsg = trim(extmsg)//' rho_u_sc_pos_0'
+ if (any(ini%rho_u_sc_neg_0 < 0.0_pREAL)) extmsg = trim(extmsg)//' rho_u_sc_neg_0'
+ if (any(ini%rho_d_ed_0 < 0.0_pREAL)) extmsg = trim(extmsg)//' rho_d_ed_0'
+ if (any(ini%rho_d_sc_0 < 0.0_pREAL)) extmsg = trim(extmsg)//' rho_d_sc_0'
- if (any(prm%peierlsstress < 0.0_pReal)) extmsg = trim(extmsg)//' tau_peierls'
- if (any(prm%minDipoleHeight < 0.0_pReal)) extmsg = trim(extmsg)//' d_ed or d_sc'
+ if (any(prm%peierlsstress < 0.0_pREAL)) extmsg = trim(extmsg)//' tau_peierls'
+ if (any(prm%minDipoleHeight < 0.0_pREAL)) extmsg = trim(extmsg)//' d_ed or d_sc'
- if (prm%B < 0.0_pReal) extmsg = trim(extmsg)//' B'
- if (prm%Q_cl < 0.0_pReal) extmsg = trim(extmsg)//' Q_cl'
- if (prm%nu_a <= 0.0_pReal) extmsg = trim(extmsg)//' nu_a'
- if (prm%w <= 0.0_pReal) extmsg = trim(extmsg)//' w'
- if (prm%D_0 < 0.0_pReal) extmsg = trim(extmsg)//' D_0'
- if (prm%V_at <= 0.0_pReal) extmsg = trim(extmsg)//' V_at' ! ToDo: in dislotungsten, the atomic volume is given as a factor
+ if (prm%B < 0.0_pREAL) extmsg = trim(extmsg)//' B'
+ if (prm%Q_cl < 0.0_pREAL) extmsg = trim(extmsg)//' Q_cl'
+ if (prm%nu_a <= 0.0_pREAL) extmsg = trim(extmsg)//' nu_a'
+ if (prm%w <= 0.0_pREAL) extmsg = trim(extmsg)//' w'
+ if (prm%D_0 < 0.0_pREAL) extmsg = trim(extmsg)//' D_0'
+ if (prm%V_at <= 0.0_pREAL) extmsg = trim(extmsg)//' V_at' ! ToDo: in dislotungsten, the atomic volume is given as a factor
- if (prm%rho_min < 0.0_pReal) extmsg = trim(extmsg)//' rho_min'
- if (prm%rho_significant < 0.0_pReal) extmsg = trim(extmsg)//' rho_significant'
- if (prm%atol_rho < 0.0_pReal) extmsg = trim(extmsg)//' atol_rho'
- if (prm%C_CFL < 0.0_pReal) extmsg = trim(extmsg)//' C_CFL'
+ if (prm%rho_min < 0.0_pREAL) extmsg = trim(extmsg)//' rho_min'
+ if (prm%rho_significant < 0.0_pREAL) extmsg = trim(extmsg)//' rho_significant'
+ if (prm%atol_rho < 0.0_pREAL) extmsg = trim(extmsg)//' atol_rho'
+ if (prm%C_CFL < 0.0_pREAL) extmsg = trim(extmsg)//' C_CFL'
- if (prm%p <= 0.0_pReal .or. prm%p > 1.0_pReal) extmsg = trim(extmsg)//' p_sl'
- if (prm%q < 1.0_pReal .or. prm%q > 2.0_pReal) extmsg = trim(extmsg)//' q_sl'
+ if (prm%p <= 0.0_pREAL .or. prm%p > 1.0_pREAL) extmsg = trim(extmsg)//' p_sl'
+ if (prm%q < 1.0_pREAL .or. prm%q > 2.0_pREAL) extmsg = trim(extmsg)//' q_sl'
- if (prm%f_F < 0.0_pReal .or. prm%f_F > 1.0_pReal) &
+ if (prm%f_F < 0.0_pREAL .or. prm%f_F > 1.0_pREAL) &
extmsg = trim(extmsg)//' f_F'
- if (prm%f_ed < 0.0_pReal .or. prm%f_ed > 1.0_pReal) &
+ if (prm%f_ed < 0.0_pREAL .or. prm%f_ed > 1.0_pREAL) &
extmsg = trim(extmsg)//' f_ed'
- if (prm%Q_sol <= 0.0_pReal) extmsg = trim(extmsg)//' Q_sol'
- if (prm%f_sol <= 0.0_pReal) extmsg = trim(extmsg)//' f_sol'
- if (prm%c_sol <= 0.0_pReal) extmsg = trim(extmsg)//' c_sol'
+ if (prm%Q_sol <= 0.0_pREAL) extmsg = trim(extmsg)//' Q_sol'
+ if (prm%f_sol <= 0.0_pREAL) extmsg = trim(extmsg)//' f_sol'
+ if (prm%c_sol <= 0.0_pREAL) extmsg = trim(extmsg)//' c_sol'
- if (prm%chi_GB > 1.0_pReal) extmsg = trim(extmsg)//' chi_GB'
- if (prm%chi_surface < 0.0_pReal .or. prm%chi_surface > 1.0_pReal) &
+ if (prm%chi_GB > 1.0_pREAL) extmsg = trim(extmsg)//' chi_GB'
+ if (prm%chi_surface < 0.0_pREAL .or. prm%chi_surface > 1.0_pREAL) &
extmsg = trim(extmsg)//' chi_surface'
- if (prm%f_ed_mult < 0.0_pReal .or. prm%f_ed_mult > 1.0_pReal) &
+ if (prm%f_ed_mult < 0.0_pREAL .or. prm%f_ed_mult > 1.0_pREAL) &
extmsg = trim(extmsg)//' f_ed_mult'
end if slipActive
@@ -491,8 +491,8 @@ module function plastic_nonlocal_init() result(myPlasticity)
stt%gamma => plasticState(ph)%state (10*prm%sum_N_sl + 1:11*prm%sum_N_sl,1:Nmembers)
dot%gamma => plasticState(ph)%dotState (10*prm%sum_N_sl + 1:11*prm%sum_N_sl,1:Nmembers)
del%gamma => plasticState(ph)%deltaState (10*prm%sum_N_sl + 1:11*prm%sum_N_sl,1:Nmembers)
- plasticState(ph)%atol(10*prm%sum_N_sl+1:11*prm%sum_N_sl ) = pl%get_asFloat('atol_gamma', defaultVal = 1.0e-6_pReal)
- if (any(plasticState(ph)%atol(10*prm%sum_N_sl+1:11*prm%sum_N_sl) < 0.0_pReal)) &
+ plasticState(ph)%atol(10*prm%sum_N_sl+1:11*prm%sum_N_sl ) = pl%get_asReal('atol_gamma', defaultVal = 1.0e-6_pREAL)
+ if (any(plasticState(ph)%atol(10*prm%sum_N_sl+1:11*prm%sum_N_sl) < 0.0_pREAL)) &
extmsg = trim(extmsg)//' atol_gamma'
stt%rho_forest => plasticState(ph)%state (11*prm%sum_N_sl + 1:12*prm%sum_N_sl,1:Nmembers)
@@ -502,9 +502,9 @@ module function plastic_nonlocal_init() result(myPlasticity)
stt%v_scr_pos => plasticState(ph)%state (14*prm%sum_N_sl + 1:15*prm%sum_N_sl,1:Nmembers)
stt%v_scr_neg => plasticState(ph)%state (15*prm%sum_N_sl + 1:16*prm%sum_N_sl,1:Nmembers)
- allocate(dst%tau_pass(prm%sum_N_sl,Nmembers),source=0.0_pReal)
- allocate(dst%tau_back(prm%sum_N_sl,Nmembers),source=0.0_pReal)
- allocate(dst%compatibility(2,maxval(param%sum_N_sl),maxval(param%sum_N_sl),nIPneighbors,Nmembers),source=0.0_pReal)
+ allocate(dst%tau_pass(prm%sum_N_sl,Nmembers),source=0.0_pREAL)
+ allocate(dst%tau_back(prm%sum_N_sl,Nmembers),source=0.0_pREAL)
+ allocate(dst%compatibility(2,maxval(param%sum_N_sl),maxval(param%sum_N_sl),nIPneighbors,Nmembers),source=0.0_pREAL)
end associate
if (Nmembers > 0) call stateInit(ini,ph,Nmembers)
@@ -516,7 +516,7 @@ module function plastic_nonlocal_init() result(myPlasticity)
end do
allocate(compatibility(2,maxval(param%sum_N_sl),maxval(param%sum_N_sl),nIPneighbors,&
- discretization_nIPs,discretization_Nelems), source=0.0_pReal)
+ discretization_nIPs,discretization_Nelems), source=0.0_pREAL)
! BEGIN DEPRECATED----------------------------------------------------------------------------------
allocate(iRhoU(maxval(param%sum_N_sl),4,phases%length), source=0)
@@ -573,45 +573,45 @@ module subroutine nonlocal_dependentState(ph, en)
s, & ! slip system index
dir, &
n
- real(pReal) :: &
+ real(pREAL) :: &
FVsize, &
nRealNeighbors, & ! number of really existing neighbors
mu, &
nu
integer, dimension(2) :: &
neighbors
- real(pReal), dimension(2) :: &
+ real(pREAL), dimension(2) :: &
rhoExcessGradient, &
rhoExcessGradient_over_rho, &
rhoTotal
- real(pReal), dimension(3) :: &
+ real(pREAL), dimension(3) :: &
rhoExcessDifferences, &
normal_latticeConf
- real(pReal), dimension(3,3) :: &
+ real(pREAL), dimension(3,3) :: &
invFe, & !< inverse of elastic deformation gradient
invFp, & !< inverse of plastic deformation gradient
connections, &
invConnections
- real(pReal), dimension(3,nIPneighbors) :: &
+ real(pREAL), dimension(3,nIPneighbors) :: &
connection_latticeConf
- real(pReal), dimension(2,param(ph)%sum_N_sl) :: &
+ real(pREAL), dimension(2,param(ph)%sum_N_sl) :: &
rhoExcess
- real(pReal), dimension(param(ph)%sum_N_sl) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl) :: &
rho_edg_delta, &
rho_scr_delta
- real(pReal), dimension(param(ph)%sum_N_sl,10) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl,10) :: &
rho, &
rho0, &
rho_neighbor0
- real(pReal), dimension(param(ph)%sum_N_sl,param(ph)%sum_N_sl) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl,param(ph)%sum_N_sl) :: &
myInteractionMatrix ! corrected slip interaction matrix
- real(pReal), dimension(param(ph)%sum_N_sl,nIPneighbors) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl,nIPneighbors) :: &
rho_edg_delta_neighbor, &
rho_scr_delta_neighbor
- real(pReal), dimension(2,maxval(param%sum_N_sl),nIPneighbors) :: &
+ real(pREAL), dimension(2,maxval(param%sum_N_sl),nIPneighbors) :: &
neighbor_rhoExcess, & ! excess density at neighboring material point
neighbor_rhoTotal ! total density at neighboring material point
- real(pReal), dimension(3,param(ph)%sum_N_sl,2) :: &
+ real(pREAL), dimension(3,param(ph)%sum_N_sl,2) :: &
m ! direction of dislocation motion
associate(prm => param(ph),dst => dependentState(ph), stt => state(ph))
@@ -628,10 +628,10 @@ module subroutine nonlocal_dependentState(ph, en)
! (see Kubin,Devincre,Hoc; 2008; Modeling dislocation storage rates and mean free paths in face-centered cubic crystals)
if (any(phase_lattice(ph) == ['cI','cF'])) then
myInteractionMatrix = prm%h_sl_sl &
- * spread(( 1.0_pReal - prm%f_F &
+ * spread(( 1.0_pREAL - prm%f_F &
+ prm%f_F &
- * log(0.35_pReal * prm%b_sl * sqrt(max(stt%rho_forest(:,en),prm%rho_significant))) &
- / log(0.35_pReal * prm%b_sl * 1e6_pReal))**2,2,prm%sum_N_sl)
+ * log(0.35_pREAL * prm%b_sl * sqrt(max(stt%rho_forest(:,en),prm%rho_significant))) &
+ / log(0.35_pREAL * prm%b_sl * 1e6_pREAL))**2,2,prm%sum_N_sl)
else
myInteractionMatrix = prm%h_sl_sl
end if
@@ -657,12 +657,12 @@ module subroutine nonlocal_dependentState(ph, en)
rhoExcess(1,:) = rho_edg_delta
rhoExcess(2,:) = rho_scr_delta
- FVsize = geom(ph)%V_0(en)**(1.0_pReal/3.0_pReal)
+ FVsize = geom(ph)%V_0(en)**(1.0_pREAL/3.0_pREAL)
!* loop through my neighborhood and get the connection vectors (in lattice frame) and the excess densities
- nRealNeighbors = 0.0_pReal
- neighbor_rhoTotal = 0.0_pReal
+ nRealNeighbors = 0.0_pREAL
+ neighbor_rhoTotal = 0.0_pREAL
do n = 1,nIPneighbors
neighbor_el = geom(ph)%IPneighborhood(1,n,en)
neighbor_ip = geom(ph)%IPneighborhood(2,n,en)
@@ -670,7 +670,7 @@ module subroutine nonlocal_dependentState(ph, en)
if (neighbor_el > 0 .and. neighbor_ip > 0) then
if (material_ID_phase(1,(neighbor_el-1)*discretization_nIPs + neighbor_ip) == ph) then
no = material_entry_phase(1,(neighbor_el-1)*discretization_nIPs + neighbor_ip)
- nRealNeighbors = nRealNeighbors + 1.0_pReal
+ nRealNeighbors = nRealNeighbors + 1.0_pREAL
rho_neighbor0 = getRho0(ph,no)
rho_edg_delta_neighbor(:,n) = rho_neighbor0(:,mob_edg_pos) - rho_neighbor0(:,mob_edg_neg)
@@ -682,17 +682,17 @@ module subroutine nonlocal_dependentState(ph, en)
connection_latticeConf(1:3,n) = matmul(invFe, geom(ph)%IPcoordinates(1:3,no) &
- geom(ph)%IPcoordinates(1:3,en))
normal_latticeConf = matmul(transpose(invFp), geom(ph)%IPareaNormal(1:3,n,en))
- if (math_inner(normal_latticeConf,connection_latticeConf(1:3,n)) < 0.0_pReal) & ! neighboring connection points in opposite direction to face normal: must be periodic image
+ if (math_inner(normal_latticeConf,connection_latticeConf(1:3,n)) < 0.0_pREAL) & ! neighboring connection points in opposite direction to face normal: must be periodic image
connection_latticeConf(1:3,n) = normal_latticeConf * geom(ph)%V_0(en)/geom(ph)%IParea(n,en) ! instead take the surface normal scaled with the diameter of the cell
else
! local neighbor or different lattice structure or different constitution instance -> use central values instead
- connection_latticeConf(1:3,n) = 0.0_pReal
+ connection_latticeConf(1:3,n) = 0.0_pREAL
rho_edg_delta_neighbor(:,n) = rho_edg_delta
rho_scr_delta_neighbor(:,n) = rho_scr_delta
end if
else
! free surface -> use central values instead
- connection_latticeConf(1:3,n) = 0.0_pReal
+ connection_latticeConf(1:3,n) = 0.0_pREAL
rho_edg_delta_neighbor(:,n) = rho_edg_delta
rho_scr_delta_neighbor(:,n) = rho_scr_delta
end if
@@ -730,15 +730,15 @@ module subroutine nonlocal_dependentState(ph, en)
rhoExcessGradient(2) = rhoExcessGradient(2) + sum(rho(s,imm_scr)) / FVsize
! ... normalized with the total density ...
- rhoTotal(1) = (sum(abs(rho(s,edg))) + sum(neighbor_rhoTotal(1,s,:))) / (1.0_pReal + nRealNeighbors)
- rhoTotal(2) = (sum(abs(rho(s,scr))) + sum(neighbor_rhoTotal(2,s,:))) / (1.0_pReal + nRealNeighbors)
+ rhoTotal(1) = (sum(abs(rho(s,edg))) + sum(neighbor_rhoTotal(1,s,:))) / (1.0_pREAL + nRealNeighbors)
+ rhoTotal(2) = (sum(abs(rho(s,scr))) + sum(neighbor_rhoTotal(2,s,:))) / (1.0_pREAL + nRealNeighbors)
- rhoExcessGradient_over_rho = 0.0_pReal
- where(rhoTotal > 0.0_pReal) rhoExcessGradient_over_rho = rhoExcessGradient / rhoTotal
+ rhoExcessGradient_over_rho = 0.0_pREAL
+ where(rhoTotal > 0.0_pREAL) rhoExcessGradient_over_rho = rhoExcessGradient / rhoTotal
! ... gives the local stress correction when multiplied with a factor
- dst%tau_back(s,en) = - mu * prm%b_sl(s) / (2.0_pReal * PI) &
- * ( rhoExcessGradient_over_rho(1) / (1.0_pReal - nu) &
+ dst%tau_back(s,en) = - mu * prm%b_sl(s) / (2.0_pREAL * PI) &
+ * ( rhoExcessGradient_over_rho(1) / (1.0_pREAL - nu) &
+ rhoExcessGradient_over_rho(2))
end do
end if
@@ -753,39 +753,39 @@ end subroutine nonlocal_dependentState
!--------------------------------------------------------------------------------------------------
module subroutine nonlocal_LpAndItsTangent(Lp,dLp_dMp, &
Mp,ph,en)
- real(pReal), dimension(3,3), intent(out) :: &
+ real(pREAL), dimension(3,3), intent(out) :: &
Lp !< plastic velocity gradient
- real(pReal), dimension(3,3,3,3), intent(out) :: &
+ real(pREAL), dimension(3,3,3,3), intent(out) :: &
dLp_dMp
integer, intent(in) :: &
ph, &
en
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp
!< derivative of Lp with respect to Mp
integer :: &
i, j, k, l, &
t, & !< dislocation type
s !< index of my current slip system
- real(pReal), dimension(param(ph)%sum_N_sl,8) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl,8) :: &
rhoSgl !< single dislocation densities (including blocked)
- real(pReal), dimension(param(ph)%sum_N_sl,10) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl,10) :: &
rho
- real(pReal), dimension(param(ph)%sum_N_sl,4) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl,4) :: &
v, & !< velocity
tauNS, & !< resolved shear stress including non Schmid and backstress terms
dv_dtau, & !< velocity derivative with respect to the shear stress
dv_dtauNS !< velocity derivative with respect to the shear stress
- real(pReal), dimension(param(ph)%sum_N_sl) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl) :: &
tau, & !< resolved shear stress including backstress terms
dot_gamma !< shear rate
- real(pReal) :: &
+ real(pREAL) :: &
Temperature !< temperature
Temperature = thermal_T(ph,en)
- Lp = 0.0_pReal
- dLp_dMp = 0.0_pReal
+ Lp = 0.0_pREAL
+ dLp_dMp = 0.0_pREAL
associate(prm => param(ph),dst=>dependentState(ph),stt=>state(ph))
@@ -797,7 +797,7 @@ module subroutine nonlocal_LpAndItsTangent(Lp,dLp_dMp, &
tau(s) = math_tensordot(Mp, prm%P_sl(1:3,1:3,s))
tauNS(s,1) = tau(s)
tauNS(s,2) = tau(s)
- if (tau(s) > 0.0_pReal) then
+ if (tau(s) > 0.0_pREAL) then
tauNS(s,3) = math_tensordot(Mp, +prm%P_nS_pos(1:3,1:3,s))
tauNS(s,4) = math_tensordot(Mp, -prm%P_nS_neg(1:3,1:3,s))
else
@@ -830,7 +830,7 @@ module subroutine nonlocal_LpAndItsTangent(Lp,dLp_dMp, &
stt%v(:,en) = pack(v,.true.)
!*** Bauschinger effect
- forall (s = 1:prm%sum_N_sl, t = 5:8, rhoSgl(s,t) * v(s,t-4) < 0.0_pReal) &
+ forall (s = 1:prm%sum_N_sl, t = 5:8, rhoSgl(s,t) * v(s,t-4) < 0.0_pREAL) &
rhoSgl(s,t-4) = rhoSgl(s,t-4) + abs(rhoSgl(s,t))
dot_gamma = sum(rhoSgl(:,1:4) * v, 2) * prm%b_sl
@@ -856,7 +856,7 @@ end subroutine nonlocal_LpAndItsTangent
!--------------------------------------------------------------------------------------------------
module subroutine plastic_nonlocal_deltaState(Mp,ph,en)
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp !< MandelStress
integer, intent(in) :: &
ph, &
@@ -866,19 +866,19 @@ module subroutine plastic_nonlocal_deltaState(Mp,ph,en)
c, & ! character of dislocation
t, & ! type of dislocation
s ! index of my current slip system
- real(pReal) :: &
+ real(pREAL) :: &
mu, &
nu
- real(pReal), dimension(param(ph)%sum_N_sl,10) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl,10) :: &
deltaRhoRemobilization, & ! density increment by remobilization
deltaRhoDipole2SingleStress ! density increment by dipole dissociation (by stress change)
- real(pReal), dimension(param(ph)%sum_N_sl,10) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl,10) :: &
rho ! current dislocation densities
- real(pReal), dimension(param(ph)%sum_N_sl,4) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl,4) :: &
v ! dislocation glide velocity
- real(pReal), dimension(param(ph)%sum_N_sl) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl) :: &
tau ! current resolved shear stress
- real(pReal), dimension(param(ph)%sum_N_sl,2) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl,2) :: &
rhoDip, & ! current dipole dislocation densities (screw and edge dipoles)
dUpper, & ! current maximum stable dipole distance for edges and screws
dUpperOld, & ! old maximum stable dipole distance for edges and screws
@@ -899,16 +899,16 @@ module subroutine plastic_nonlocal_deltaState(Mp,ph,en)
!****************************************************************************
!*** dislocation remobilization (bauschinger effect)
- where(rho(:,imm) * v < 0.0_pReal)
+ where(rho(:,imm) * v < 0.0_pREAL)
deltaRhoRemobilization(:,mob) = abs(rho(:,imm))
deltaRhoRemobilization(:,imm) = - rho(:,imm)
rho(:,mob) = rho(:,mob) + abs(rho(:,imm))
- rho(:,imm) = 0.0_pReal
+ rho(:,imm) = 0.0_pREAL
elsewhere
- deltaRhoRemobilization(:,mob) = 0.0_pReal
- deltaRhoRemobilization(:,imm) = 0.0_pReal
+ deltaRhoRemobilization(:,mob) = 0.0_pREAL
+ deltaRhoRemobilization(:,imm) = 0.0_pREAL
endwhere
- deltaRhoRemobilization(:,dip) = 0.0_pReal
+ deltaRhoRemobilization(:,dip) = 0.0_pREAL
!****************************************************************************
!*** calculate dipole formation and dissociation by stress change
@@ -916,32 +916,32 @@ module subroutine plastic_nonlocal_deltaState(Mp,ph,en)
!*** calculate limits for stable dipole height
do s = 1,prm%sum_N_sl
tau(s) = math_tensordot(Mp, prm%P_sl(1:3,1:3,s)) +dst%tau_back(s,en)
- if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal
+ if (abs(tau(s)) < 1.0e-15_pREAL) tau(s) = 1.0e-15_pREAL
end do
- dUpper(:,1) = mu * prm%b_sl/(8.0_pReal * PI * (1.0_pReal - nu) * abs(tau))
- dUpper(:,2) = mu * prm%b_sl/(4.0_pReal * PI * abs(tau))
+ dUpper(:,1) = mu * prm%b_sl/(8.0_pREAL * PI * (1.0_pREAL - nu) * abs(tau))
+ dUpper(:,2) = mu * prm%b_sl/(4.0_pREAL * PI * abs(tau))
where(dNeq0(sqrt(sum(abs(rho(:,edg)),2)))) &
- dUpper(:,1) = min(1.0_pReal/sqrt(sum(abs(rho(:,edg)),2)),dUpper(:,1))
+ dUpper(:,1) = min(1.0_pREAL/sqrt(sum(abs(rho(:,edg)),2)),dUpper(:,1))
where(dNeq0(sqrt(sum(abs(rho(:,scr)),2)))) &
- dUpper(:,2) = min(1.0_pReal/sqrt(sum(abs(rho(:,scr)),2)),dUpper(:,2))
+ dUpper(:,2) = min(1.0_pREAL/sqrt(sum(abs(rho(:,scr)),2)),dUpper(:,2))
dUpper = max(dUpper,prm%minDipoleHeight)
deltaDUpper = dUpper - dUpperOld
!*** dissociation by stress increase
- deltaRhoDipole2SingleStress = 0.0_pReal
- forall (c=1:2, s=1:prm%sum_N_sl, deltaDUpper(s,c) < 0.0_pReal .and. &
+ deltaRhoDipole2SingleStress = 0.0_pREAL
+ forall (c=1:2, s=1:prm%sum_N_sl, deltaDUpper(s,c) < 0.0_pREAL .and. &
dNeq0(dUpperOld(s,c) - prm%minDipoleHeight(s,c))) &
deltaRhoDipole2SingleStress(s,8+c) = rhoDip(s,c) * deltaDUpper(s,c) &
/ (dUpperOld(s,c) - prm%minDipoleHeight(s,c))
- forall (t=1:4) deltaRhoDipole2SingleStress(:,t) = -0.5_pReal * deltaRhoDipole2SingleStress(:,(t-1)/2+9)
+ forall (t=1:4) deltaRhoDipole2SingleStress(:,t) = -0.5_pREAL * deltaRhoDipole2SingleStress(:,(t-1)/2+9)
forall (s = 1:prm%sum_N_sl, c = 1:2) plasticState(ph)%state(iD(s,c,ph),en) = dUpper(s,c)
- plasticState(ph)%deltaState(:,en) = 0.0_pReal
+ plasticState(ph)%deltaState(:,en) = 0.0_pREAL
del%rho(:,en) = reshape(deltaRhoRemobilization + deltaRhoDipole2SingleStress, [10*prm%sum_N_sl])
end associate
@@ -955,9 +955,9 @@ end subroutine plastic_nonlocal_deltaState
module subroutine nonlocal_dotState(Mp,timestep, &
ph,en)
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp !< MandelStress
- real(pReal), intent(in) :: &
+ real(pREAL), intent(in) :: &
timestep !< substepped crystallite time increment
integer, intent(in) :: &
ph, &
@@ -967,7 +967,7 @@ module subroutine nonlocal_dotState(Mp,timestep, &
c, & !< character of dislocation
t, & !< type of dislocation
s !< index of my current slip system
- real(pReal), dimension(param(ph)%sum_N_sl,10) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl,10) :: &
rho, &
rho0, & !< dislocation density at beginning of time step
rhoDot, & !< density evolution
@@ -975,27 +975,27 @@ module subroutine nonlocal_dotState(Mp,timestep, &
rhoDotSingle2DipoleGlide, & !< density evolution by dipole formation (by glide)
rhoDotAthermalAnnihilation, & !< density evolution by athermal annihilation
rhoDotThermalAnnihilation !< density evolution by thermal annihilation
- real(pReal), dimension(param(ph)%sum_N_sl,8) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl,8) :: &
rhoSgl, & !< current single dislocation densities (positive/negative screw and edge without dipoles)
my_rhoSgl0 !< single dislocation densities of central ip (positive/negative screw and edge without dipoles)
- real(pReal), dimension(param(ph)%sum_N_sl,4) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl,4) :: &
v, & !< current dislocation glide velocity
v0, &
dot_gamma !< shear rates
- real(pReal), dimension(param(ph)%sum_N_sl) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl) :: &
tau, & !< current resolved shear stress
v_climb !< climb velocity of edge dipoles
- real(pReal), dimension(param(ph)%sum_N_sl,2) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl,2) :: &
rhoDip, & !< current dipole dislocation densities (screw and edge dipoles)
dLower, & !< minimum stable dipole distance for edges and screws
dUpper !< current maximum stable dipole distance for edges and screws
- real(pReal) :: &
+ real(pREAL) :: &
D_SD, &
mu, &
nu, Temperature
- if (timestep <= 0.0_pReal) then
- plasticState(ph)%dotState = 0.0_pReal
+ if (timestep <= 0.0_pREAL) then
+ plasticState(ph)%dotState = 0.0_pREAL
return
end if
@@ -1005,8 +1005,8 @@ module subroutine nonlocal_dotState(Mp,timestep, &
nu = elastic_nu(ph,en,prm%isotropic_bound)
Temperature = thermal_T(ph,en)
- tau = 0.0_pReal
- dot_gamma = 0.0_pReal
+ tau = 0.0_pREAL
+ dot_gamma = 0.0_pREAL
rho = getRho(ph,en)
rhoSgl = rho(:,sgl)
@@ -1022,31 +1022,31 @@ module subroutine nonlocal_dotState(Mp,timestep, &
! limits for stable dipole height
do s = 1,prm%sum_N_sl
tau(s) = math_tensordot(Mp, prm%P_sl(1:3,1:3,s)) + dst%tau_back(s,en)
- if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal
+ if (abs(tau(s)) < 1.0e-15_pREAL) tau(s) = 1.0e-15_pREAL
end do
dLower = prm%minDipoleHeight
- dUpper(:,1) = mu * prm%b_sl/(8.0_pReal * PI * (1.0_pReal - nu) * abs(tau))
- dUpper(:,2) = mu * prm%b_sl/(4.0_pReal * PI * abs(tau))
+ dUpper(:,1) = mu * prm%b_sl/(8.0_pREAL * PI * (1.0_pREAL - nu) * abs(tau))
+ dUpper(:,2) = mu * prm%b_sl/(4.0_pREAL * PI * abs(tau))
where(dNeq0(sqrt(sum(abs(rho(:,edg)),2)))) &
- dUpper(:,1) = min(1.0_pReal/sqrt(sum(abs(rho(:,edg)),2)),dUpper(:,1))
+ dUpper(:,1) = min(1.0_pREAL/sqrt(sum(abs(rho(:,edg)),2)),dUpper(:,1))
where(dNeq0(sqrt(sum(abs(rho(:,scr)),2)))) &
- dUpper(:,2) = min(1.0_pReal/sqrt(sum(abs(rho(:,scr)),2)),dUpper(:,2))
+ dUpper(:,2) = min(1.0_pREAL/sqrt(sum(abs(rho(:,scr)),2)),dUpper(:,2))
dUpper = max(dUpper,dLower)
! dislocation multiplication
- rhoDotMultiplication = 0.0_pReal
+ rhoDotMultiplication = 0.0_pREAL
isBCC: if (phase_lattice(ph) == 'cI') then
- forall (s = 1:prm%sum_N_sl, sum(abs(v(s,1:4))) > 0.0_pReal)
+ forall (s = 1:prm%sum_N_sl, sum(abs(v(s,1:4))) > 0.0_pREAL)
rhoDotMultiplication(s,1:2) = sum(abs(dot_gamma(s,3:4))) / prm%b_sl(s) & ! assuming double-cross-slip of screws to be decisive for multiplication
* sqrt(stt%rho_forest(s,en)) / prm%i_sl(s) ! & ! mean free path
- ! * 2.0_pReal * sum(abs(v(s,3:4))) / sum(abs(v(s,1:4))) ! ratio of screw to overall velocity determines edge generation
+ ! * 2.0_pREAL * sum(abs(v(s,3:4))) / sum(abs(v(s,1:4))) ! ratio of screw to overall velocity determines edge generation
rhoDotMultiplication(s,3:4) = sum(abs(dot_gamma(s,3:4))) /prm%b_sl(s) & ! assuming double-cross-slip of screws to be decisive for multiplication
* sqrt(stt%rho_forest(s,en)) / prm%i_sl(s) ! & ! mean free path
- ! * 2.0_pReal * sum(abs(v(s,1:2))) / sum(abs(v(s,1:4))) ! ratio of edge to overall velocity determines screw generation
+ ! * 2.0_pREAL * sum(abs(v(s,1:2))) / sum(abs(v(s,1:4))) ! ratio of edge to overall velocity determines screw generation
endforall
else isBCC
@@ -1063,20 +1063,20 @@ module subroutine nonlocal_dotState(Mp,timestep, &
! formation by glide
do c = 1,2
- rhoDotSingle2DipoleGlide(:,2*c-1) = -2.0_pReal * dUpper(:,c) / prm%b_sl &
+ rhoDotSingle2DipoleGlide(:,2*c-1) = -2.0_pREAL * dUpper(:,c) / prm%b_sl &
* ( rhoSgl(:,2*c-1) * abs(dot_gamma(:,2*c)) & ! negative mobile --> positive mobile
+ rhoSgl(:,2*c) * abs(dot_gamma(:,2*c-1)) & ! positive mobile --> negative mobile
+ abs(rhoSgl(:,2*c+4)) * abs(dot_gamma(:,2*c-1))) ! positive mobile --> negative immobile
- rhoDotSingle2DipoleGlide(:,2*c) = -2.0_pReal * dUpper(:,c) / prm%b_sl &
+ rhoDotSingle2DipoleGlide(:,2*c) = -2.0_pREAL * dUpper(:,c) / prm%b_sl &
* ( rhoSgl(:,2*c-1) * abs(dot_gamma(:,2*c)) & ! negative mobile --> positive mobile
+ rhoSgl(:,2*c) * abs(dot_gamma(:,2*c-1)) & ! positive mobile --> negative mobile
+ abs(rhoSgl(:,2*c+3)) * abs(dot_gamma(:,2*c))) ! negative mobile --> positive immobile
- rhoDotSingle2DipoleGlide(:,2*c+3) = -2.0_pReal * dUpper(:,c) / prm%b_sl &
+ rhoDotSingle2DipoleGlide(:,2*c+3) = -2.0_pREAL * dUpper(:,c) / prm%b_sl &
* rhoSgl(:,2*c+3) * abs(dot_gamma(:,2*c)) ! negative mobile --> positive immobile
- rhoDotSingle2DipoleGlide(:,2*c+4) = -2.0_pReal * dUpper(:,c) / prm%b_sl &
+ rhoDotSingle2DipoleGlide(:,2*c+4) = -2.0_pREAL * dUpper(:,c) / prm%b_sl &
* rhoSgl(:,2*c+4) * abs(dot_gamma(:,2*c-1)) ! positive mobile --> negative immobile
rhoDotSingle2DipoleGlide(:,c+8) = abs(rhoDotSingle2DipoleGlide(:,2*c+3)) &
@@ -1087,27 +1087,27 @@ module subroutine nonlocal_dotState(Mp,timestep, &
! athermal annihilation
- rhoDotAthermalAnnihilation = 0.0_pReal
+ rhoDotAthermalAnnihilation = 0.0_pREAL
forall (c=1:2) &
- rhoDotAthermalAnnihilation(:,c+8) = -2.0_pReal * dLower(:,c) / prm%b_sl &
- * ( 2.0_pReal * (rhoSgl(:,2*c-1) * abs(dot_gamma(:,2*c)) + rhoSgl(:,2*c) * abs(dot_gamma(:,2*c-1))) & ! was single hitting single
- + 2.0_pReal * (abs(rhoSgl(:,2*c+3)) * abs(dot_gamma(:,2*c)) + abs(rhoSgl(:,2*c+4)) * abs(dot_gamma(:,2*c-1))) & ! was single hitting immobile single or was immobile single hit by single
+ rhoDotAthermalAnnihilation(:,c+8) = -2.0_pREAL * dLower(:,c) / prm%b_sl &
+ * ( 2.0_pREAL * (rhoSgl(:,2*c-1) * abs(dot_gamma(:,2*c)) + rhoSgl(:,2*c) * abs(dot_gamma(:,2*c-1))) & ! was single hitting single
+ + 2.0_pREAL * (abs(rhoSgl(:,2*c+3)) * abs(dot_gamma(:,2*c)) + abs(rhoSgl(:,2*c+4)) * abs(dot_gamma(:,2*c-1))) & ! was single hitting immobile single or was immobile single hit by single
+ rhoDip(:,c) * (abs(dot_gamma(:,2*c-1)) + abs(dot_gamma(:,2*c)))) ! single knocks dipole constituent
! annihilated screw dipoles leave edge jogs behind on the colinear system
if (phase_lattice(ph) == 'cF') &
forall (s = 1:prm%sum_N_sl, prm%colinearSystem(s) > 0) &
rhoDotAthermalAnnihilation(prm%colinearSystem(s),1:2) = - rhoDotAthermalAnnihilation(s,10) &
- * 0.25_pReal * sqrt(stt%rho_forest(s,en)) * (dUpper(s,2) + dLower(s,2)) * prm%f_ed
+ * 0.25_pREAL * sqrt(stt%rho_forest(s,en)) * (dUpper(s,2) + dLower(s,2)) * prm%f_ed
! thermally activated annihilation of edge dipoles by climb
- rhoDotThermalAnnihilation = 0.0_pReal
+ rhoDotThermalAnnihilation = 0.0_pREAL
D_SD = prm%D_0 * exp(-prm%Q_cl / (K_B * Temperature)) ! eq. 3.53
v_climb = D_SD * mu * prm%V_at &
- / (PI * (1.0_pReal-nu) * (dUpper(:,1) + dLower(:,1)) * K_B * Temperature) ! eq. 3.54
+ / (PI * (1.0_pREAL-nu) * (dUpper(:,1) + dLower(:,1)) * K_B * Temperature) ! eq. 3.54
forall (s = 1:prm%sum_N_sl, dUpper(s,1) > dLower(s,1)) &
- rhoDotThermalAnnihilation(s,9) = max(- 4.0_pReal * rhoDip(s,1) * v_climb(s) / (dUpper(s,1) - dLower(s,1)), &
+ rhoDotThermalAnnihilation(s,9) = max(- 4.0_pREAL * rhoDip(s,1) * v_climb(s) / (dUpper(s,1) - dLower(s,1)), &
- rhoDip(s,1) / timestep - rhoDotAthermalAnnihilation(s,9) &
- rhoDotSingle2DipoleGlide(s,9)) ! make sure that we do not annihilate more dipoles than we have
@@ -1120,7 +1120,7 @@ module subroutine nonlocal_dotState(Mp,timestep, &
if ( any(rho(:,mob) + rhoDot(:,1:4) * timestep < -prm%atol_rho) &
.or. any(rho(:,dip) + rhoDot(:,9:10) * timestep < -prm%atol_rho)) then
- plasticState(ph)%dotState = IEEE_value(1.0_pReal,IEEE_quiet_NaN)
+ plasticState(ph)%dotState = IEEE_value(1.0_pREAL,IEEE_quiet_NaN)
else
dot%rho(:,en) = pack(rhoDot,.true.)
dot%gamma(:,en) = sum(dot_gamma,2)
@@ -1139,7 +1139,7 @@ non_recursive function rhoDotFlux(timestep,ph,en)
#else
function rhoDotFlux(timestep,ph,en)
#endif
- real(pReal), intent(in) :: &
+ real(pREAL), intent(in) :: &
timestep !< substepped crystallite time increment
integer, intent(in) :: &
ph, &
@@ -1161,33 +1161,33 @@ function rhoDotFlux(timestep,ph,en)
np,& !< neighbor phase shortcut
topp, & !< type of dislocation with opposite sign to t
s !< index of my current slip system
- real(pReal), dimension(param(ph)%sum_N_sl,10) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl,10) :: &
rho, &
rho0, & !< dislocation density at beginning of time step
rhoDotFlux !< density evolution by flux
- real(pReal), dimension(param(ph)%sum_N_sl,8) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl,8) :: &
rhoSgl, & !< current single dislocation densities (positive/negative screw and edge without dipoles)
neighbor_rhoSgl0, & !< current single dislocation densities of neighboring ip (positive/negative screw and edge without dipoles)
my_rhoSgl0 !< single dislocation densities of central ip (positive/negative screw and edge without dipoles)
- real(pReal), dimension(param(ph)%sum_N_sl,4) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl,4) :: &
v, & !< current dislocation glide velocity
v0, &
neighbor_v0, & !< dislocation glide velocity of enighboring ip
dot_gamma !< shear rates
- real(pReal), dimension(3,param(ph)%sum_N_sl,4) :: &
+ real(pREAL), dimension(3,param(ph)%sum_N_sl,4) :: &
m !< direction of dislocation motion
- real(pReal), dimension(3,3) :: &
+ real(pREAL), dimension(3,3) :: &
my_F, & !< my total deformation gradient
neighbor_F, & !< total deformation gradient of my neighbor
my_Fe, & !< my elastic deformation gradient
neighbor_Fe, & !< elastic deformation gradient of my neighbor
Favg !< average total deformation gradient of en and my neighbor
- real(pReal), dimension(3) :: &
+ real(pREAL), dimension(3) :: &
normal_neighbor2me, & !< interface normal pointing from my neighbor to en in neighbor's lattice configuration
normal_neighbor2me_defConf, & !< interface normal pointing from my neighbor to en in shared deformed configuration
normal_me2neighbor, & !< interface normal pointing from en to my neighbor in my lattice configuration
normal_me2neighbor_defConf !< interface normal pointing from en to my neighbor in shared deformed configuration
- real(pReal) :: &
+ real(pREAL) :: &
area, & !< area of the current interface
transmissivity, & !< overall transmissivity of dislocation flux to neighboring material point
lineLength !< dislocation line length leaving the current interface
@@ -1198,7 +1198,7 @@ function rhoDotFlux(timestep,ph,en)
stt => state(ph))
ns = prm%sum_N_sl
- dot_gamma = 0.0_pReal
+ dot_gamma = 0.0_pREAL
rho = getRho(ph,en)
rhoSgl = rho(:,sgl)
@@ -1212,14 +1212,14 @@ function rhoDotFlux(timestep,ph,en)
!****************************************************************************
!*** calculate dislocation fluxes (only for nonlocal plasticity)
- rhoDotFlux = 0.0_pReal
+ rhoDotFlux = 0.0_pREAL
if (plasticState(ph)%nonlocal) then
!*** check CFL (Courant-Friedrichs-Lewy) condition for flux
- if (any( abs(dot_gamma) > 0.0_pReal & ! any active slip system ...
+ if (any( abs(dot_gamma) > 0.0_pREAL & ! any active slip system ...
.and. prm%C_CFL * abs(v0) * timestep &
> geom(ph)%V_0(en)/ maxval(geom(ph)%IParea(:,en)))) then ! ...with velocity above critical value (we use the reference volume and area for simplicity here)
- rhoDotFlux = IEEE_value(1.0_pReal,IEEE_quiet_NaN) ! enforce cutback
+ rhoDotFlux = IEEE_value(1.0_pREAL,IEEE_quiet_NaN) ! enforce cutback
return
end if
@@ -1251,12 +1251,12 @@ function rhoDotFlux(timestep,ph,en)
if (neighbor_n > 0) then ! if neighbor exists, average deformation gradient
neighbor_F = phase_mechanical_F(np)%data(1:3,1:3,no)
neighbor_Fe = matmul(neighbor_F, math_inv33(phase_mechanical_Fp(np)%data(1:3,1:3,no)))
- Favg = 0.5_pReal * (my_F + neighbor_F)
+ Favg = 0.5_pREAL * (my_F + neighbor_F)
else ! if no neighbor, take my value as average
Favg = my_F
end if
- neighbor_v0 = 0.0_pReal ! needed for check of sign change in flux density below
+ neighbor_v0 = 0.0_pREAL ! needed for check of sign change in flux density below
!* FLUX FROM MY NEIGHBOR TO ME
!* This is only considered, if I have a neighbor of nonlocal plasticity
@@ -1268,16 +1268,16 @@ function rhoDotFlux(timestep,ph,en)
!* compatibility
if (neighbor_n > 0) then
if (phase_plasticity(np) == PLASTIC_NONLOCAL_ID .and. &
- any(dependentState(ph)%compatibility(:,:,:,n,en) > 0.0_pReal)) then
+ any(dependentState(ph)%compatibility(:,:,:,n,en) > 0.0_pREAL)) then
forall (s = 1:ns, t = 1:4)
neighbor_v0(s,t) = plasticState(np)%state0(iV (s,t,np),no)
- neighbor_rhoSgl0(s,t) = max(plasticState(np)%state0(iRhoU(s,t,np),no),0.0_pReal)
+ neighbor_rhoSgl0(s,t) = max(plasticState(np)%state0(iRhoU(s,t,np),no),0.0_pREAL)
endforall
- where (neighbor_rhoSgl0 * IPvolume(neighbor_ip,neighbor_el) ** 0.667_pReal < prm%rho_min &
+ where (neighbor_rhoSgl0 * IPvolume(neighbor_ip,neighbor_el) ** 0.667_pREAL < prm%rho_min &
.or. neighbor_rhoSgl0 < prm%rho_significant) &
- neighbor_rhoSgl0 = 0.0_pReal
+ neighbor_rhoSgl0 = 0.0_pREAL
normal_neighbor2me_defConf = math_det33(Favg) * matmul(math_inv33(transpose(Favg)), &
IPareaNormal(1:3,neighbor_n,neighbor_ip,neighbor_el)) ! normal of the interface in (average) deformed configuration (pointing neighbor => en)
normal_neighbor2me = matmul(transpose(neighbor_Fe), normal_neighbor2me_defConf) &
@@ -1288,14 +1288,14 @@ function rhoDotFlux(timestep,ph,en)
do t = 1,4
c = (t + 1) / 2
topp = t + mod(t,2) - mod(t+1,2)
- if (neighbor_v0(s,t) * math_inner(m(1:3,s,t), normal_neighbor2me) > 0.0_pReal & ! flux from my neighbor to en == entering flux for en
- .and. v0(s,t) * neighbor_v0(s,t) >= 0.0_pReal ) then ! ... only if no sign change in flux density
+ if (neighbor_v0(s,t) * math_inner(m(1:3,s,t), normal_neighbor2me) > 0.0_pREAL & ! flux from my neighbor to en == entering flux for en
+ .and. v0(s,t) * neighbor_v0(s,t) >= 0.0_pREAL ) then ! ... only if no sign change in flux density
lineLength = neighbor_rhoSgl0(s,t) * neighbor_v0(s,t) &
* math_inner(m(1:3,s,t), normal_neighbor2me) * area ! positive line length that wants to enter through this interface
- where (dependentState(ph)%compatibility(c,:,s,n,en) > 0.0_pReal) &
+ where (dependentState(ph)%compatibility(c,:,s,n,en) > 0.0_pREAL) &
rhoDotFlux(:,t) = rhoDotFlux(1:ns,t) &
+ lineLength/geom(ph)%V_0(en)*dependentState(ph)%compatibility(c,:,s,n,en)**2 ! transferring to equally signed mobile dislocation type
- where (dependentState(ph)%compatibility(c,:,s,n,en) < 0.0_pReal) &
+ where (dependentState(ph)%compatibility(c,:,s,n,en) < 0.0_pREAL) &
rhoDotFlux(:,topp) = rhoDotFlux(:,topp) &
+ lineLength/geom(ph)%V_0(en)*dependentState(ph)%compatibility(c,:,s,n,en)**2 ! transferring to opposite signed mobile dislocation type
@@ -1324,18 +1324,18 @@ function rhoDotFlux(timestep,ph,en)
do s = 1,ns
do t = 1,4
c = (t + 1) / 2
- if (v0(s,t) * math_inner(m(1:3,s,t), normal_me2neighbor) > 0.0_pReal ) then ! flux from en to my neighbor == leaving flux for en (might also be a pure flux from my mobile density to dead density if interface not at all transmissive)
- if (v0(s,t) * neighbor_v0(s,t) >= 0.0_pReal) then ! no sign change in flux density
+ if (v0(s,t) * math_inner(m(1:3,s,t), normal_me2neighbor) > 0.0_pREAL ) then ! flux from en to my neighbor == leaving flux for en (might also be a pure flux from my mobile density to dead density if interface not at all transmissive)
+ if (v0(s,t) * neighbor_v0(s,t) >= 0.0_pREAL) then ! no sign change in flux density
transmissivity = sum(dependentState(ph)%compatibility(c,:,s,n,en)**2) ! overall transmissivity from this slip system to my neighbor
else ! sign change in flux density means sign change in stress which does not allow for dislocations to arive at the neighbor
- transmissivity = 0.0_pReal
+ transmissivity = 0.0_pREAL
end if
lineLength = my_rhoSgl0(s,t) * v0(s,t) &
* math_inner(m(1:3,s,t), normal_me2neighbor) * area ! positive line length of mobiles that wants to leave through this interface
rhoDotFlux(s,t) = rhoDotFlux(s,t) - lineLength / geom(ph)%V_0(en) ! subtract dislocation flux from current type
rhoDotFlux(s,t+4) = rhoDotFlux(s,t+4) &
- + lineLength / geom(ph)%V_0(en) * (1.0_pReal - transmissivity) &
- * sign(1.0_pReal, v0(s,t)) ! dislocation flux that is not able to leave through interface (because of low transmissivity) will remain as immobile single density at the material point
+ + lineLength / geom(ph)%V_0(en) * (1.0_pREAL - transmissivity) &
+ * sign(1.0_pREAL, v0(s,t)) ! dislocation flux that is not able to leave through interface (because of low transmissivity) will remain as immobile single density at the material point
end if
end do
end do
@@ -1374,9 +1374,9 @@ module subroutine plastic_nonlocal_updateCompatibility(orientation,ph,ip,el)
ns, & ! number of active slip systems
s1, & ! slip system index (en)
s2 ! slip system index (my neighbor)
- real(pReal), dimension(2,param(ph)%sum_N_sl,param(ph)%sum_N_sl,nIPneighbors) :: &
+ real(pREAL), dimension(2,param(ph)%sum_N_sl,param(ph)%sum_N_sl,nIPneighbors) :: &
my_compatibility ! my_compatibility for current element and ip
- real(pReal) :: &
+ real(pREAL) :: &
my_compatibilitySum, &
thresholdValue, &
nThresholdValues
@@ -1390,8 +1390,8 @@ module subroutine plastic_nonlocal_updateCompatibility(orientation,ph,ip,el)
en = material_entry_phase(1,(el-1)*discretization_nIPs + ip)
!*** start out fully compatible
- my_compatibility = 0.0_pReal
- forall(s1 = 1:ns) my_compatibility(:,s1,s1,:) = 1.0_pReal
+ my_compatibility = 0.0_pREAL
+ forall(s1 = 1:ns) my_compatibility(:,s1,s1,:) = 1.0_pREAL
neighbors: do n = 1,nIPneighbors
neighbor_e = IPneighborhood(1,n,ip,el)
@@ -1405,8 +1405,8 @@ module subroutine plastic_nonlocal_updateCompatibility(orientation,ph,ip,el)
elseif (neighbor_phase /= ph) then
!* PHASE BOUNDARY
if (plasticState(neighbor_phase)%nonlocal .and. plasticState(ph)%nonlocal) &
- forall(s1 = 1:ns) my_compatibility(:,s1,s1,n) = 0.0_pReal
- elseif (prm%chi_GB >= 0.0_pReal) then
+ forall(s1 = 1:ns) my_compatibility(:,s1,s1,n) = 0.0_pREAL
+ elseif (prm%chi_GB >= 0.0_pREAL) then
!* GRAIN BOUNDARY
if (any(dNeq(phase_O_0(ph)%data(en)%asQuaternion(), &
phase_O_0(neighbor_phase)%data(neighbor_me)%asQuaternion())) .and. &
@@ -1435,21 +1435,21 @@ module subroutine plastic_nonlocal_updateCompatibility(orientation,ph,ip,el)
mis%rotate(prm%slip_direction(1:3,s2))))
end do neighborSlipSystems
- my_compatibilitySum = 0.0_pReal
+ my_compatibilitySum = 0.0_pREAL
belowThreshold = .true.
- do while (my_compatibilitySum < 1.0_pReal .and. any(belowThreshold))
+ do while (my_compatibilitySum < 1.0_pREAL .and. any(belowThreshold))
thresholdValue = maxval(my_compatibility(2,:,s1,n), belowThreshold) ! screws always positive
- nThresholdValues = real(count(my_compatibility(2,:,s1,n) >= thresholdValue),pReal)
+ nThresholdValues = real(count(my_compatibility(2,:,s1,n) >= thresholdValue),pREAL)
where (my_compatibility(2,:,s1,n) >= thresholdValue) belowThreshold = .false.
- if (my_compatibilitySum + thresholdValue * nThresholdValues > 1.0_pReal) &
+ if (my_compatibilitySum + thresholdValue * nThresholdValues > 1.0_pREAL) &
where (abs(my_compatibility(:,:,s1,n)) >= thresholdValue) &
- my_compatibility(:,:,s1,n) = sign((1.0_pReal - my_compatibilitySum)/nThresholdValues,&
+ my_compatibility(:,:,s1,n) = sign((1.0_pREAL - my_compatibilitySum)/nThresholdValues,&
my_compatibility(:,:,s1,n))
my_compatibilitySum = my_compatibilitySum + nThresholdValues * thresholdValue
end do
- where(belowThreshold) my_compatibility(1,:,s1,n) = 0.0_pReal
- where(belowThreshold) my_compatibility(2,:,s1,n) = 0.0_pReal
+ where(belowThreshold) my_compatibility(1,:,s1,n) = 0.0_pREAL
+ where(belowThreshold) my_compatibility(2,:,s1,n) = 0.0_pREAL
end do mySlipSystems
end if
@@ -1556,9 +1556,9 @@ subroutine stateInit(ini,phase,Nentries)
from, &
upto, &
s
- real(pReal), dimension(2) :: &
+ real(pREAL), dimension(2) :: &
rnd
- real(pReal) :: &
+ real(pREAL) :: &
meanDensity, &
totalVolume, &
densityBinning, &
@@ -1567,17 +1567,17 @@ subroutine stateInit(ini,phase,Nentries)
associate(stt => state(phase))
- if (ini%random_rho_u > 0.0_pReal) then ! randomly distribute dislocation segments on random slip system and of random type in the volume
+ if (ini%random_rho_u > 0.0_pREAL) then ! randomly distribute dislocation segments on random slip system and of random type in the volume
totalVolume = sum(geom(phase)%V_0)
minimumIPVolume = minval(geom(phase)%V_0)
- densityBinning = ini%random_rho_u_binning / minimumIpVolume ** (2.0_pReal / 3.0_pReal)
+ densityBinning = ini%random_rho_u_binning / minimumIpVolume ** (2.0_pREAL / 3.0_pREAL)
! fill random material points with dislocation segments until the desired overall density is reached
- meanDensity = 0.0_pReal
+ meanDensity = 0.0_pREAL
do while(meanDensity < ini%random_rho_u)
call random_number(rnd)
- e = nint(rnd(1)*real(Nentries,pReal) + 0.5_pReal)
- s = nint(rnd(2)*real(sum(ini%N_sl),pReal)*4.0_pReal + 0.5_pReal)
+ e = nint(rnd(1)*real(Nentries,pREAL) + 0.5_pREAL)
+ s = nint(rnd(2)*real(sum(ini%N_sl),pREAL)*4.0_pREAL + 0.5_pREAL)
meanDensity = meanDensity + densityBinning * geom(phase)%V_0(e) / totalVolume
stt%rhoSglMobile(s,e) = densityBinning
end do
@@ -1607,20 +1607,20 @@ pure subroutine kinetics(v, dv_dtau, dv_dtauNS, tau, tauNS, tauThreshold, c, T,
integer, intent(in) :: &
c, & !< dislocation character (1:edge, 2:screw)
ph
- real(pReal), intent(in) :: &
+ real(pREAL), intent(in) :: &
T !< T
- real(pReal), dimension(param(ph)%sum_N_sl), intent(in) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl), intent(in) :: &
tau, & !< resolved external shear stress (without non Schmid effects)
tauNS, & !< resolved external shear stress (including non Schmid effects)
tauThreshold !< threshold shear stress
- real(pReal), dimension(param(ph)%sum_N_sl), intent(out) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl), intent(out) :: &
v, & !< velocity
dv_dtau, & !< velocity derivative with respect to resolved shear stress (without non Schmid contributions)
dv_dtauNS !< velocity derivative with respect to resolved shear stress (including non Schmid contributions)
integer :: &
s !< index of my current slip system
- real(pReal) :: &
+ real(pREAL) :: &
tauRel_P, &
tauRel_S, &
tauEff, & !< effective shear stress
@@ -1637,9 +1637,9 @@ pure subroutine kinetics(v, dv_dtau, dv_dtauNS, tau, tauNS, tauThreshold, c, T,
criticalStress_S !< maximum obstacle strength
- v = 0.0_pReal
- dv_dtau = 0.0_pReal
- dv_dtauNS = 0.0_pReal
+ v = 0.0_pREAL
+ dv_dtau = 0.0_pREAL
+ dv_dtauNS = 0.0_pREAL
associate(prm => param(ph))
@@ -1647,18 +1647,18 @@ pure subroutine kinetics(v, dv_dtau, dv_dtauNS, tau, tauNS, tauThreshold, c, T,
if (abs(tau(s)) > tauThreshold(s)) then
!* Peierls contribution
- tauEff = max(0.0_pReal, abs(tauNS(s)) - tauThreshold(s))
+ tauEff = max(0.0_pREAL, abs(tauNS(s)) - tauThreshold(s))
lambda_P = prm%b_sl(s)
activationVolume_P = prm%w *prm%b_sl(s)**3
criticalStress_P = prm%peierlsStress(s,c)
activationEnergy_P = criticalStress_P * activationVolume_P
- tauRel_P = min(1.0_pReal, tauEff / criticalStress_P)
- tPeierls = 1.0_pReal / prm%nu_a &
+ tauRel_P = min(1.0_pREAL, tauEff / criticalStress_P)
+ tPeierls = 1.0_pREAL / prm%nu_a &
* exp(activationEnergy_P / (K_B * T) &
- * (1.0_pReal - tauRel_P**prm%p)**prm%q)
+ * (1.0_pREAL - tauRel_P**prm%p)**prm%q)
dtPeierls_dtau = merge(tPeierls * prm%p * prm%q * activationVolume_P / (K_B * T) &
- * (1.0_pReal - tauRel_P**prm%p)**(prm%q-1.0_pReal) * tauRel_P**(prm%p-1.0_pReal), &
- 0.0_pReal, &
+ * (1.0_pREAL - tauRel_P**prm%p)**(prm%q-1.0_pREAL) * tauRel_P**(prm%p-1.0_pREAL), &
+ 0.0_pREAL, &
tauEff < criticalStress_P)
! Contribution from solid solution strengthening
@@ -1666,19 +1666,19 @@ pure subroutine kinetics(v, dv_dtau, dv_dtauNS, tau, tauNS, tauThreshold, c, T,
lambda_S = prm%b_sl(s) / sqrt(prm%c_sol)
activationVolume_S = prm%f_sol * prm%b_sl(s)**3 / sqrt(prm%c_sol)
criticalStress_S = prm%Q_sol / activationVolume_S
- tauRel_S = min(1.0_pReal, tauEff / criticalStress_S)
- tSolidSolution = 1.0_pReal / prm%nu_a &
- * exp(prm%Q_sol / (K_B * T)* (1.0_pReal - tauRel_S**prm%p)**prm%q)
+ tauRel_S = min(1.0_pREAL, tauEff / criticalStress_S)
+ tSolidSolution = 1.0_pREAL / prm%nu_a &
+ * exp(prm%Q_sol / (K_B * T)* (1.0_pREAL - tauRel_S**prm%p)**prm%q)
dtSolidSolution_dtau = merge(tSolidSolution * prm%p * prm%q * activationVolume_S / (K_B * T) &
- * (1.0_pReal - tauRel_S**prm%p)**(prm%q-1.0_pReal)* tauRel_S**(prm%p-1.0_pReal), &
- 0.0_pReal, &
+ * (1.0_pREAL - tauRel_S**prm%p)**(prm%q-1.0_pREAL)* tauRel_S**(prm%p-1.0_pREAL), &
+ 0.0_pREAL, &
tauEff < criticalStress_S)
!* viscous glide velocity
tauEff = abs(tau(s)) - tauThreshold(s)
- v(s) = sign(1.0_pReal,tau(s)) &
+ v(s) = sign(1.0_pREAL,tau(s)) &
/ (tPeierls / lambda_P + tSolidSolution / lambda_S + prm%B /(prm%b_sl(s) * tauEff))
dv_dtau(s) = v(s)**2 * (dtSolidSolution_dtau / lambda_S + prm%B / (prm%b_sl(s) * tauEff**2))
dv_dtauNS(s) = v(s)**2 * dtPeierls_dtau / lambda_P
@@ -1698,7 +1698,7 @@ end subroutine kinetics
pure function getRho(ph,en) result(rho)
integer, intent(in) :: ph, en
- real(pReal), dimension(param(ph)%sum_N_sl,10) :: rho
+ real(pREAL), dimension(param(ph)%sum_N_sl,10) :: rho
associate(prm => param(ph))
@@ -1706,11 +1706,11 @@ pure function getRho(ph,en) result(rho)
rho = reshape(state(ph)%rho(:,en),[prm%sum_N_sl,10])
! ensure positive densities (not for imm, they have a sign)
- rho(:,mob) = max(rho(:,mob),0.0_pReal)
- rho(:,dip) = max(rho(:,dip),0.0_pReal)
+ rho(:,mob) = max(rho(:,mob),0.0_pREAL)
+ rho(:,dip) = max(rho(:,dip),0.0_pREAL)
- where(abs(rho) < max(prm%rho_min/geom(ph)%V_0(en)**(2.0_pReal/3.0_pReal),prm%rho_significant)) &
- rho = 0.0_pReal
+ where(abs(rho) < max(prm%rho_min/geom(ph)%V_0(en)**(2.0_pREAL/3.0_pREAL),prm%rho_significant)) &
+ rho = 0.0_pREAL
end associate
@@ -1724,7 +1724,7 @@ end function getRho
pure function getRho0(ph,en) result(rho0)
integer, intent(in) :: ph, en
- real(pReal), dimension(param(ph)%sum_N_sl,10) :: rho0
+ real(pREAL), dimension(param(ph)%sum_N_sl,10) :: rho0
associate(prm => param(ph))
@@ -1732,11 +1732,11 @@ pure function getRho0(ph,en) result(rho0)
rho0 = reshape(state0(ph)%rho(:,en),[prm%sum_N_sl,10])
! ensure positive densities (not for imm, they have a sign)
- rho0(:,mob) = max(rho0(:,mob),0.0_pReal)
- rho0(:,dip) = max(rho0(:,dip),0.0_pReal)
+ rho0(:,mob) = max(rho0(:,mob),0.0_pREAL)
+ rho0(:,dip) = max(rho0(:,dip),0.0_pREAL)
- where (abs(rho0) < max(prm%rho_min/geom(ph)%V_0(en)**(2.0_pReal/3.0_pReal),prm%rho_significant)) &
- rho0 = 0.0_pReal
+ where (abs(rho0) < max(prm%rho_min/geom(ph)%V_0(en)**(2.0_pREAL/3.0_pREAL),prm%rho_significant)) &
+ rho0 = 0.0_pREAL
end associate
@@ -1748,10 +1748,10 @@ subroutine storeGeometry(ph)
integer, intent(in) :: ph
integer :: ce, co, nCell
- real(pReal), dimension(:), allocatable :: V
+ real(pREAL), dimension(:), allocatable :: V
integer, dimension(:,:,:), allocatable :: neighborhood
- real(pReal), dimension(:,:), allocatable :: area, coords
- real(pReal), dimension(:,:,:), allocatable :: areaNormal
+ real(pREAL), dimension(:,:), allocatable :: area, coords
+ real(pREAL), dimension(:,:,:), allocatable :: areaNormal
nCell = product(shape(IPvolume))
diff --git a/src/phase_mechanical_plastic_phenopowerlaw.f90 b/src/phase_mechanical_plastic_phenopowerlaw.f90
index 11556db78..b83c7a2d4 100644
--- a/src/phase_mechanical_plastic_phenopowerlaw.f90
+++ b/src/phase_mechanical_plastic_phenopowerlaw.f90
@@ -7,30 +7,30 @@
submodule(phase:plastic) phenopowerlaw
type :: tParameters
- real(pReal) :: &
- dot_gamma_0_sl = 1.0_pReal, & !< reference shear strain rate for slip
- dot_gamma_0_tw = 1.0_pReal, & !< reference shear strain rate for twin
- n_sl = 1.0_pReal, & !< stress exponent for slip
- n_tw = 1.0_pReal, & !< stress exponent for twin
- f_sat_sl_tw = 1.0_pReal, & !< push-up factor for slip saturation due to twinning
- c_1 = 1.0_pReal, &
- c_2 = 1.0_pReal, &
- c_3 = 1.0_pReal, &
- c_4 = 1.0_pReal, &
- h_0_sl_sl = 1.0_pReal, & !< reference hardening slip - slip
- h_0_tw_sl = 1.0_pReal, & !< reference hardening twin - slip
- h_0_tw_tw = 1.0_pReal, & !< reference hardening twin - twin
- a_sl = 1.0_pReal
- real(pReal), allocatable, dimension(:) :: &
+ real(pREAL) :: &
+ dot_gamma_0_sl = 1.0_pREAL, & !< reference shear strain rate for slip
+ dot_gamma_0_tw = 1.0_pREAL, & !< reference shear strain rate for twin
+ n_sl = 1.0_pREAL, & !< stress exponent for slip
+ n_tw = 1.0_pREAL, & !< stress exponent for twin
+ f_sat_sl_tw = 1.0_pREAL, & !< push-up factor for slip saturation due to twinning
+ c_1 = 1.0_pREAL, &
+ c_2 = 1.0_pREAL, &
+ c_3 = 1.0_pREAL, &
+ c_4 = 1.0_pREAL, &
+ h_0_sl_sl = 1.0_pREAL, & !< reference hardening slip - slip
+ h_0_tw_sl = 1.0_pREAL, & !< reference hardening twin - slip
+ h_0_tw_tw = 1.0_pREAL, & !< reference hardening twin - twin
+ a_sl = 1.0_pREAL
+ real(pREAL), allocatable, dimension(:) :: &
xi_inf_sl, & !< maximum critical shear stress for slip
h_int, & !< per family hardening activity (optional)
gamma_char !< characteristic shear for twins
- real(pReal), allocatable, dimension(:,:) :: &
+ real(pREAL), allocatable, dimension(:,:) :: &
h_sl_sl, & !< slip resistance from slip activity
h_sl_tw, & !< slip resistance from twin activity
h_tw_sl, & !< twin resistance from slip activity
h_tw_tw !< twin resistance from twin activity
- real(pReal), allocatable, dimension(:,:,:) :: &
+ real(pREAL), allocatable, dimension(:,:,:) :: &
P_sl, &
P_tw, &
P_nS_pos, &
@@ -40,7 +40,7 @@ submodule(phase:plastic) phenopowerlaw
sum_N_tw !< total number of active twin systems
logical :: &
nonSchmidActive = .false.
- character(len=pStringLen), allocatable, dimension(:) :: &
+ character(len=pSTRLEN), allocatable, dimension(:) :: &
output
character(len=:), allocatable, dimension(:) :: &
systems_sl, &
@@ -56,7 +56,7 @@ submodule(phase:plastic) phenopowerlaw
end type tIndexDotState
type :: tPhenopowerlawState
- real(pReal), pointer, dimension(:,:) :: &
+ real(pREAL), pointer, dimension(:,:) :: &
xi_sl, &
xi_tw, &
gamma_sl, &
@@ -87,7 +87,7 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
integer, dimension(:), allocatable :: &
N_sl, & !< number of slip-systems for a given slip family
N_tw !< number of twin-systems for a given twin family
- real(pReal), dimension(:), allocatable :: &
+ real(pREAL), dimension(:), allocatable :: &
xi_0_sl, & !< initial critical shear stress for slip
xi_0_tw, & !< initial critical shear stress for twin
a !< non-Schmid coefficients
@@ -129,9 +129,9 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
if (len(refs) > 0) print'(/,1x,a)', refs
#if defined (__GFORTRAN__)
- prm%output = output_as1dString(pl)
+ prm%output = output_as1dStr(pl)
#else
- prm%output = pl%get_as1dString('output',defaultVal=emptyStringArray)
+ prm%output = pl%get_as1dStr('output',defaultVal=emptyStrArray)
#endif
!--------------------------------------------------------------------------------------------------
@@ -143,7 +143,7 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
prm%P_sl = lattice_SchmidMatrix_slip(N_sl,phase_lattice(ph),phase_cOverA(ph))
if (phase_lattice(ph) == 'cI') then
- a = pl%get_as1dFloat('a_nonSchmid',defaultVal=emptyRealArray)
+ a = pl%get_as1dReal('a_nonSchmid',defaultVal=emptyRealArray)
if (size(a) > 0) prm%nonSchmidActive = .true.
prm%P_nS_pos = lattice_nonSchmidMatrix(N_sl,a,+1)
prm%P_nS_neg = lattice_nonSchmidMatrix(N_sl,a,-1)
@@ -151,17 +151,17 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
prm%P_nS_pos = prm%P_sl
prm%P_nS_neg = prm%P_sl
end if
- prm%h_sl_sl = lattice_interaction_SlipBySlip(N_sl,pl%get_as1dFloat('h_sl-sl'),phase_lattice(ph))
+ prm%h_sl_sl = lattice_interaction_SlipBySlip(N_sl,pl%get_as1dReal('h_sl-sl'),phase_lattice(ph))
- xi_0_sl = pl%get_as1dFloat('xi_0_sl', requiredSize=size(N_sl))
- prm%xi_inf_sl = pl%get_as1dFloat('xi_inf_sl', requiredSize=size(N_sl))
- prm%h_int = pl%get_as1dFloat('h_int', requiredSize=size(N_sl), &
- defaultVal=[(0.0_pReal,i=1,size(N_sl))])
+ xi_0_sl = pl%get_as1dReal('xi_0_sl', requiredSize=size(N_sl))
+ prm%xi_inf_sl = pl%get_as1dReal('xi_inf_sl', requiredSize=size(N_sl))
+ prm%h_int = pl%get_as1dReal('h_int', requiredSize=size(N_sl), &
+ defaultVal=[(0.0_pREAL,i=1,size(N_sl))])
- prm%dot_gamma_0_sl = pl%get_asFloat('dot_gamma_0_sl')
- prm%n_sl = pl%get_asFloat('n_sl')
- prm%a_sl = pl%get_asFloat('a_sl')
- prm%h_0_sl_sl = pl%get_asFloat('h_0_sl-sl')
+ prm%dot_gamma_0_sl = pl%get_asReal('dot_gamma_0_sl')
+ prm%n_sl = pl%get_asReal('n_sl')
+ prm%a_sl = pl%get_asReal('a_sl')
+ prm%h_0_sl_sl = pl%get_asReal('h_0_sl-sl')
! expand: family => system
xi_0_sl = math_expand(xi_0_sl, N_sl)
@@ -169,11 +169,11 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
prm%h_int = math_expand(prm%h_int, N_sl)
! sanity checks
- if ( prm%dot_gamma_0_sl <= 0.0_pReal) extmsg = trim(extmsg)//' dot_gamma_0_sl'
- if ( prm%a_sl <= 0.0_pReal) extmsg = trim(extmsg)//' a_sl'
- if ( prm%n_sl <= 0.0_pReal) extmsg = trim(extmsg)//' n_sl'
- if (any(xi_0_sl <= 0.0_pReal)) extmsg = trim(extmsg)//' xi_0_sl'
- if (any(prm%xi_inf_sl <= 0.0_pReal)) extmsg = trim(extmsg)//' xi_inf_sl'
+ if ( prm%dot_gamma_0_sl <= 0.0_pREAL) extmsg = trim(extmsg)//' dot_gamma_0_sl'
+ if ( prm%a_sl <= 0.0_pREAL) extmsg = trim(extmsg)//' a_sl'
+ if ( prm%n_sl <= 0.0_pREAL) extmsg = trim(extmsg)//' n_sl'
+ if (any(xi_0_sl <= 0.0_pREAL)) extmsg = trim(extmsg)//' xi_0_sl'
+ if (any(prm%xi_inf_sl <= 0.0_pREAL)) extmsg = trim(extmsg)//' xi_inf_sl'
else slipActive
xi_0_sl = emptyRealArray
@@ -187,27 +187,27 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
prm%sum_N_tw = sum(abs(N_tw))
twinActive: if (prm%sum_N_tw > 0) then
prm%systems_tw = lattice_labels_twin(N_tw,phase_lattice(ph))
- prm%P_tw = lattice_SchmidMatrix_twin(N_tw,phase_lattice(ph),phase_cOverA(ph))
- prm%h_tw_tw = lattice_interaction_TwinByTwin(N_tw,pl%get_as1dFloat('h_tw-tw'),phase_lattice(ph))
+ prm%P_tw = lattice_SchmidMatrix_twin(N_tw,phase_lattice(ph),phase_cOverA(ph))
+ prm%h_tw_tw = lattice_interaction_TwinByTwin(N_tw,pl%get_as1dReal('h_tw-tw'),phase_lattice(ph))
prm%gamma_char = lattice_characteristicShear_twin(N_tw,phase_lattice(ph),phase_cOverA(ph))
- xi_0_tw = pl%get_as1dFloat('xi_0_tw',requiredSize=size(N_tw))
+ xi_0_tw = pl%get_as1dReal('xi_0_tw',requiredSize=size(N_tw))
- prm%c_1 = pl%get_asFloat('c_1',defaultVal=0.0_pReal)
- prm%c_2 = pl%get_asFloat('c_2',defaultVal=1.0_pReal)
- prm%c_3 = pl%get_asFloat('c_3',defaultVal=0.0_pReal)
- prm%c_4 = pl%get_asFloat('c_4',defaultVal=0.0_pReal)
- prm%dot_gamma_0_tw = pl%get_asFloat('dot_gamma_0_tw')
- prm%n_tw = pl%get_asFloat('n_tw')
- prm%f_sat_sl_tw = pl%get_asFloat('f_sat_sl-tw')
- prm%h_0_tw_tw = pl%get_asFloat('h_0_tw-tw')
+ prm%c_1 = pl%get_asReal('c_1',defaultVal=0.0_pREAL)
+ prm%c_2 = pl%get_asReal('c_2',defaultVal=1.0_pREAL)
+ prm%c_3 = pl%get_asReal('c_3',defaultVal=0.0_pREAL)
+ prm%c_4 = pl%get_asReal('c_4',defaultVal=0.0_pREAL)
+ prm%dot_gamma_0_tw = pl%get_asReal('dot_gamma_0_tw')
+ prm%n_tw = pl%get_asReal('n_tw')
+ prm%f_sat_sl_tw = pl%get_asReal('f_sat_sl-tw')
+ prm%h_0_tw_tw = pl%get_asReal('h_0_tw-tw')
! expand: family => system
xi_0_tw = math_expand(xi_0_tw,N_tw)
! sanity checks
- if (prm%dot_gamma_0_tw <= 0.0_pReal) extmsg = trim(extmsg)//' dot_gamma_0_tw'
- if (prm%n_tw <= 0.0_pReal) extmsg = trim(extmsg)//' n_tw'
+ if (prm%dot_gamma_0_tw <= 0.0_pREAL) extmsg = trim(extmsg)//' dot_gamma_0_tw'
+ if (prm%n_tw <= 0.0_pREAL) extmsg = trim(extmsg)//' n_tw'
else twinActive
xi_0_tw = emptyRealArray
@@ -218,15 +218,15 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
!--------------------------------------------------------------------------------------------------
! slip-twin related parameters
slipAndTwinActive: if (prm%sum_N_sl > 0 .and. prm%sum_N_tw > 0) then
- prm%h_0_tw_sl = pl%get_asFloat('h_0_tw-sl')
- prm%h_sl_tw = lattice_interaction_SlipByTwin(N_sl,N_tw,pl%get_as1dFloat('h_sl-tw'), &
+ prm%h_0_tw_sl = pl%get_asReal('h_0_tw-sl')
+ prm%h_sl_tw = lattice_interaction_SlipByTwin(N_sl,N_tw,pl%get_as1dReal('h_sl-tw'), &
phase_lattice(ph))
- prm%h_tw_sl = lattice_interaction_TwinBySlip(N_tw,N_sl,pl%get_as1dFloat('h_tw-sl'), &
+ prm%h_tw_sl = lattice_interaction_TwinBySlip(N_tw,N_sl,pl%get_as1dReal('h_tw-sl'), &
phase_lattice(ph))
else slipAndTwinActive
allocate(prm%h_sl_tw(prm%sum_N_sl,prm%sum_N_tw)) ! at least one dimension is 0
allocate(prm%h_tw_sl(prm%sum_N_tw,prm%sum_N_sl)) ! at least one dimension is 0
- prm%h_0_tw_sl = 0.0_pReal
+ prm%h_0_tw_sl = 0.0_pREAL
end if slipAndTwinActive
!--------------------------------------------------------------------------------------------------
@@ -246,28 +246,28 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
idx_dot%xi_sl = [startIndex,endIndex]
stt%xi_sl => plasticState(ph)%state(startIndex:endIndex,:)
stt%xi_sl = spread(xi_0_sl, 2, Nmembers)
- plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_xi',defaultVal=1.0_pReal)
- if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_xi'
+ plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_xi',defaultVal=1.0_pREAL)
+ if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pREAL)) extmsg = trim(extmsg)//' atol_xi'
startIndex = endIndex + 1
endIndex = endIndex + prm%sum_N_tw
idx_dot%xi_tw = [startIndex,endIndex]
stt%xi_tw => plasticState(ph)%state(startIndex:endIndex,:)
stt%xi_tw = spread(xi_0_tw, 2, Nmembers)
- plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_xi',defaultVal=1.0_pReal)
+ plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_xi',defaultVal=1.0_pREAL)
startIndex = endIndex + 1
endIndex = endIndex + prm%sum_N_sl
idx_dot%gamma_sl = [startIndex,endIndex]
stt%gamma_sl => plasticState(ph)%state(startIndex:endIndex,:)
- plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_gamma',defaultVal=1.0e-6_pReal)
- if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_gamma'
+ plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_gamma',defaultVal=1.0e-6_pREAL)
+ if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pREAL)) extmsg = trim(extmsg)//' atol_gamma'
startIndex = endIndex + 1
endIndex = endIndex + prm%sum_N_tw
idx_dot%gamma_tw = [startIndex,endIndex]
stt%gamma_tw => plasticState(ph)%state(startIndex:endIndex,:)
- plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_gamma',defaultVal=1.0e-6_pReal)
+ plasticState(ph)%atol(startIndex:endIndex) = pl%get_asReal('atol_gamma',defaultVal=1.0e-6_pREAL)
end associate
@@ -287,12 +287,12 @@ end function plastic_phenopowerlaw_init
!--------------------------------------------------------------------------------------------------
pure module subroutine phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
- real(pReal), dimension(3,3), intent(out) :: &
+ real(pREAL), dimension(3,3), intent(out) :: &
Lp !< plastic velocity gradient
- real(pReal), dimension(3,3,3,3), intent(out) :: &
+ real(pREAL), dimension(3,3,3,3), intent(out) :: &
dLp_dMp !< derivative of Lp with respect to the Mandel stress
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer, intent(in) :: &
ph, &
@@ -300,14 +300,14 @@ pure module subroutine phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
integer :: &
i,k,l,m,n
- real(pReal), dimension(param(ph)%sum_N_sl) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl) :: &
dot_gamma_sl_pos,dot_gamma_sl_neg, &
ddot_gamma_dtau_sl_pos,ddot_gamma_dtau_sl_neg
- real(pReal), dimension(param(ph)%sum_N_tw) :: &
+ real(pREAL), dimension(param(ph)%sum_N_tw) :: &
dot_gamma_tw,ddot_gamma_dtau_tw
- Lp = 0.0_pReal
- dLp_dMp = 0.0_pReal
+ Lp = 0.0_pREAL
+ dLp_dMp = 0.0_pREAL
associate(prm => param(ph))
@@ -338,18 +338,18 @@ end subroutine phenopowerlaw_LpAndItsTangent
!--------------------------------------------------------------------------------------------------
module function phenopowerlaw_dotState(Mp,ph,en) result(dotState)
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer, intent(in) :: &
ph, &
en
- real(pReal), dimension(plasticState(ph)%sizeDotState) :: &
+ real(pREAL), dimension(plasticState(ph)%sizeDotState) :: &
dotState
- real(pReal) :: &
+ real(pREAL) :: &
xi_sl_sat_offset,&
sumF
- real(pReal), dimension(param(ph)%sum_N_sl) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl) :: &
dot_gamma_sl_pos,dot_gamma_sl_neg, &
left_SlipSlip
@@ -365,10 +365,10 @@ module function phenopowerlaw_dotState(Mp,ph,en) result(dotState)
sumF = sum(stt%gamma_tw(:,en)/prm%gamma_char)
xi_sl_sat_offset = prm%f_sat_sl_tw*sqrt(sumF)
- left_SlipSlip = sign(abs(1.0_pReal-stt%xi_sl(:,en) / (prm%xi_inf_sl+xi_sl_sat_offset))**prm%a_sl, &
- 1.0_pReal-stt%xi_sl(:,en) / (prm%xi_inf_sl+xi_sl_sat_offset))
+ left_SlipSlip = sign(abs(1.0_pREAL-stt%xi_sl(:,en) / (prm%xi_inf_sl+xi_sl_sat_offset))**prm%a_sl, &
+ 1.0_pREAL-stt%xi_sl(:,en) / (prm%xi_inf_sl+xi_sl_sat_offset))
- dot_xi_sl = prm%h_0_sl_sl * (1.0_pReal + prm%c_1 * sumF**prm%c_2) * (1.0_pReal + prm%h_int) &
+ dot_xi_sl = prm%h_0_sl_sl * (1.0_pREAL + prm%c_1 * sumF**prm%c_2) * (1.0_pREAL + prm%h_int) &
* left_SlipSlip * matmul(prm%h_sl_sl,dot_gamma_sl) &
+ matmul(prm%h_sl_tw,dot_gamma_tw)
@@ -431,20 +431,20 @@ end subroutine plastic_phenopowerlaw_result
pure subroutine kinetics_sl(Mp,ph,en, &
dot_gamma_sl_pos,dot_gamma_sl_neg,ddot_gamma_dtau_sl_pos,ddot_gamma_dtau_sl_neg)
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer, intent(in) :: &
ph, &
en
- real(pReal), intent(out), dimension(param(ph)%sum_N_sl) :: &
+ real(pREAL), intent(out), dimension(param(ph)%sum_N_sl) :: &
dot_gamma_sl_pos, &
dot_gamma_sl_neg
- real(pReal), intent(out), optional, dimension(param(ph)%sum_N_sl) :: &
+ real(pREAL), intent(out), optional, dimension(param(ph)%sum_N_sl) :: &
ddot_gamma_dtau_sl_pos, &
ddot_gamma_dtau_sl_neg
- real(pReal), dimension(param(ph)%sum_N_sl) :: &
+ real(pREAL), dimension(param(ph)%sum_N_sl) :: &
tau_sl_pos, &
tau_sl_neg
integer :: i
@@ -454,35 +454,35 @@ pure subroutine kinetics_sl(Mp,ph,en, &
do i = 1, prm%sum_N_sl
tau_sl_pos(i) = math_tensordot(Mp,prm%P_nS_pos(1:3,1:3,i))
tau_sl_neg(i) = merge(math_tensordot(Mp,prm%P_nS_neg(1:3,1:3,i)), &
- 0.0_pReal, prm%nonSchmidActive)
+ 0.0_pREAL, prm%nonSchmidActive)
end do
where(dNeq0(tau_sl_pos))
- dot_gamma_sl_pos = prm%dot_gamma_0_sl * merge(0.5_pReal,1.0_pReal, prm%nonSchmidActive) & ! 1/2 if non-Schmid active
+ dot_gamma_sl_pos = prm%dot_gamma_0_sl * merge(0.5_pREAL,1.0_pREAL, prm%nonSchmidActive) & ! 1/2 if non-Schmid active
* sign(abs(tau_sl_pos/stt%xi_sl(:,en))**prm%n_sl, tau_sl_pos)
else where
- dot_gamma_sl_pos = 0.0_pReal
+ dot_gamma_sl_pos = 0.0_pREAL
end where
where(dNeq0(tau_sl_neg))
- dot_gamma_sl_neg = prm%dot_gamma_0_sl * 0.5_pReal & ! only used if non-Schmid active, always 1/2
+ dot_gamma_sl_neg = prm%dot_gamma_0_sl * 0.5_pREAL & ! only used if non-Schmid active, always 1/2
* sign(abs(tau_sl_neg/stt%xi_sl(:,en))**prm%n_sl, tau_sl_neg)
else where
- dot_gamma_sl_neg = 0.0_pReal
+ dot_gamma_sl_neg = 0.0_pREAL
end where
if (present(ddot_gamma_dtau_sl_pos)) then
where(dNeq0(dot_gamma_sl_pos))
ddot_gamma_dtau_sl_pos = dot_gamma_sl_pos*prm%n_sl/tau_sl_pos
else where
- ddot_gamma_dtau_sl_pos = 0.0_pReal
+ ddot_gamma_dtau_sl_pos = 0.0_pREAL
end where
end if
if (present(ddot_gamma_dtau_sl_neg)) then
where(dNeq0(dot_gamma_sl_neg))
ddot_gamma_dtau_sl_neg = dot_gamma_sl_neg*prm%n_sl/tau_sl_neg
else where
- ddot_gamma_dtau_sl_neg = 0.0_pReal
+ ddot_gamma_dtau_sl_neg = 0.0_pREAL
end where
end if
@@ -501,18 +501,18 @@ end subroutine kinetics_sl
pure subroutine kinetics_tw(Mp,ph,en,&
dot_gamma_tw,ddot_gamma_dtau_tw)
- real(pReal), dimension(3,3), intent(in) :: &
+ real(pREAL), dimension(3,3), intent(in) :: &
Mp !< Mandel stress
integer, intent(in) :: &
ph, &
en
- real(pReal), dimension(param(ph)%sum_N_tw), intent(out) :: &
+ real(pREAL), dimension(param(ph)%sum_N_tw), intent(out) :: &
dot_gamma_tw
- real(pReal), dimension(param(ph)%sum_N_tw), intent(out), optional :: &
+ real(pREAL), dimension(param(ph)%sum_N_tw), intent(out), optional :: &
ddot_gamma_dtau_tw
- real(pReal), dimension(param(ph)%sum_N_tw) :: &
+ real(pREAL), dimension(param(ph)%sum_N_tw) :: &
tau_tw
integer :: i
@@ -521,18 +521,18 @@ pure subroutine kinetics_tw(Mp,ph,en,&
tau_tw = [(math_tensordot(Mp,prm%P_tw(1:3,1:3,i)),i=1,prm%sum_N_tw)]
- where(tau_tw > 0.0_pReal)
- dot_gamma_tw = (1.0_pReal-sum(stt%gamma_tw(:,en)/prm%gamma_char)) & ! only twin in untwinned volume fraction
+ where(tau_tw > 0.0_pREAL)
+ dot_gamma_tw = (1.0_pREAL-sum(stt%gamma_tw(:,en)/prm%gamma_char)) & ! only twin in untwinned volume fraction
* prm%dot_gamma_0_tw*(abs(tau_tw)/stt%xi_tw(:,en))**prm%n_tw
else where
- dot_gamma_tw = 0.0_pReal
+ dot_gamma_tw = 0.0_pREAL
end where
if (present(ddot_gamma_dtau_tw)) then
where(dNeq0(dot_gamma_tw))
ddot_gamma_dtau_tw = dot_gamma_tw*prm%n_tw/tau_tw
else where
- ddot_gamma_dtau_tw = 0.0_pReal
+ ddot_gamma_dtau_tw = 0.0_pREAL
end where
end if
diff --git a/src/phase_thermal.f90 b/src/phase_thermal.f90
index 1371f3b7f..449e08ab8 100644
--- a/src/phase_thermal.f90
+++ b/src/phase_thermal.f90
@@ -4,9 +4,9 @@
submodule(phase) thermal
type :: tThermalParameters
- real(pReal) :: C_p = 0.0_pReal !< heat capacity
- real(pReal), dimension(3,3) :: K = 0.0_pReal !< thermal conductivity
- character(len=pStringLen), allocatable, dimension(:) :: output
+ real(pREAL) :: C_p = 0.0_pREAL !< heat capacity
+ real(pREAL), dimension(3,3) :: K = 0.0_pREAL !< thermal conductivity
+ character(len=pSTRLEN), allocatable, dimension(:) :: output
end type tThermalParameters
integer, dimension(:), allocatable :: &
@@ -22,7 +22,7 @@ submodule(phase) thermal
end enum
type :: tDataContainer ! ?? not very telling name. Better: "fieldQuantities" ??
- real(pReal), dimension(:), allocatable :: T, dot_T
+ real(pREAL), dimension(:), allocatable :: T, dot_T
end type tDataContainer
integer(kind(THERMAL_UNDEFINED_ID)), dimension(:,:), allocatable :: &
thermal_source
@@ -57,14 +57,14 @@ submodule(phase) thermal
integer, intent(in) :: &
ph, &
en
- real(pReal) :: f_T
+ real(pREAL) :: f_T
end function dissipation_f_T
module function externalheat_f_T(ph,en) result(f_T)
integer, intent(in) :: &
ph, &
en
- real(pReal) :: f_T
+ real(pREAL) :: f_T
end function externalheat_f_T
end interface
@@ -100,7 +100,7 @@ module subroutine thermal_init(phases)
do ph = 1, phases%length
Nmembers = count(material_ID_phase == ph)
allocate(current(ph)%T(Nmembers),source=T_ROOM)
- allocate(current(ph)%dot_T(Nmembers),source=0.0_pReal)
+ allocate(current(ph)%dot_T(Nmembers),source=0.0_pREAL)
phase => phases%get_dict(ph)
thermal => phase%get_dict('thermal',defaultVal=emptyDict)
@@ -109,15 +109,15 @@ module subroutine thermal_init(phases)
print'(/,1x,a,i0,a)', 'phase ',ph,': '//phases%key(ph)
refs = config_listReferences(thermal,indent=3)
if (len(refs) > 0) print'(/,1x,a)', refs
- param(ph)%C_p = thermal%get_asFloat('C_p')
- param(ph)%K(1,1) = thermal%get_asFloat('K_11')
- if (any(phase_lattice(ph) == ['hP','tI'])) param(ph)%K(3,3) = thermal%get_asFloat('K_33')
+ param(ph)%C_p = thermal%get_asReal('C_p')
+ param(ph)%K(1,1) = thermal%get_asReal('K_11')
+ if (any(phase_lattice(ph) == ['hP','tI'])) param(ph)%K(3,3) = thermal%get_asReal('K_33')
param(ph)%K = lattice_symmetrize_33(param(ph)%K,phase_lattice(ph))
#if defined(__GFORTRAN__)
- param(ph)%output = output_as1dString(thermal)
+ param(ph)%output = output_as1dStr(thermal)
#else
- param(ph)%output = thermal%get_as1dString('output',defaultVal=emptyStringArray)
+ param(ph)%output = thermal%get_as1dStr('output',defaultVal=emptyStrArray)
#endif
sources => thermal%get_list('source',defaultVal=emptyList)
thermal_Nsources(ph) = sources%length
@@ -156,13 +156,13 @@ end subroutine thermal_init
module function phase_f_T(ph,en) result(f)
integer, intent(in) :: ph, en
- real(pReal) :: f
+ real(pREAL) :: f
integer :: so
- f = 0.0_pReal
+ f = 0.0_pREAL
do so = 1, thermal_Nsources(ph)
select case(thermal_source(so,ph))
@@ -211,7 +211,7 @@ end function phase_thermal_collectDotState
module function phase_mu_T(co,ce) result(mu)
integer, intent(in) :: co, ce
- real(pReal) :: mu
+ real(pREAL) :: mu
mu = phase_rho(material_ID_phase(co,ce)) &
@@ -226,7 +226,7 @@ end function phase_mu_T
module function phase_K_T(co,ce) result(K)
integer, intent(in) :: co, ce
- real(pReal), dimension(3,3) :: K
+ real(pREAL), dimension(3,3) :: K
K = crystallite_push33ToRef(co,ce,param(material_ID_phase(co,ce))%K)
@@ -236,7 +236,7 @@ end function phase_K_T
module function phase_thermal_constitutive(Delta_t,ph,en) result(converged_)
- real(pReal), intent(in) :: Delta_t
+ real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: ph, en
logical :: converged_
@@ -251,7 +251,7 @@ end function phase_thermal_constitutive
!--------------------------------------------------------------------------------------------------
function integrateThermalState(Delta_t, ph,en) result(broken)
- real(pReal), intent(in) :: Delta_t
+ real(pREAL), intent(in) :: Delta_t
integer, intent(in) :: ph, en
logical :: &
broken
@@ -323,7 +323,7 @@ end subroutine thermal_forward
pure module function thermal_T(ph,en) result(T)
integer, intent(in) :: ph, en
- real(pReal) :: T
+ real(pREAL) :: T
T = current(ph)%T(en)
@@ -337,7 +337,7 @@ end function thermal_T
module function thermal_dot_T(ph,en) result(dot_T)
integer, intent(in) :: ph, en
- real(pReal) :: dot_T
+ real(pREAL) :: dot_T
dot_T = current(ph)%dot_T(en)
@@ -350,7 +350,7 @@ end function thermal_dot_T
!----------------------------------------------------------------------------------------------
module subroutine phase_thermal_setField(T,dot_T, co,ce)
- real(pReal), intent(in) :: T, dot_T
+ real(pREAL), intent(in) :: T, dot_T
integer, intent(in) :: ce, co
@@ -387,7 +387,7 @@ function thermal_active(source_label,src_length) result(active_source)
sources => thermal%get_list('source',defaultVal=emptyList)
do s = 1, sources%length
src => sources%get_dict(s)
- active_source(s,p) = src%get_asString('type') == source_label
+ active_source(s,p) = src%get_asStr('type') == source_label
end do
end do
diff --git a/src/phase_thermal_dissipation.f90 b/src/phase_thermal_dissipation.f90
index 66bde6808..573921670 100644
--- a/src/phase_thermal_dissipation.f90
+++ b/src/phase_thermal_dissipation.f90
@@ -8,7 +8,7 @@
submodule(phase:thermal) dissipation
type :: tParameters !< container type for internal constitutive parameters
- real(pReal) :: &
+ real(pREAL) :: &
kappa !< TAYLOR-QUINNEY factor
end type tParameters
@@ -61,7 +61,7 @@ module function dissipation_init(source_length) result(mySources)
refs = config_listReferences(src,indent=3)
if (len(refs) > 0) print'(/,1x,a)', refs
- prm%kappa = src%get_asFloat('kappa')
+ prm%kappa = src%get_asReal('kappa')
Nmembers = count(material_ID_phase == ph)
call phase_allocateState(thermalState(ph)%p(so),Nmembers,0,0,0)
@@ -80,9 +80,9 @@ end function dissipation_init
module function dissipation_f_T(ph,en) result(f_T)
integer, intent(in) :: ph, en
- real(pReal) :: &
+ real(pREAL) :: &
f_T
- real(pReal), dimension(3,3) :: &
+ real(pREAL), dimension(3,3) :: &
Mp !< Mandel stress work conjugate with Lp
Mp = matmul(matmul(transpose(mechanical_F_i(ph,en)),mechanical_F_i(ph,en)),mechanical_S(ph,en))
diff --git a/src/phase_thermal_externalheat.f90 b/src/phase_thermal_externalheat.f90
index 304171c10..cdd037592 100644
--- a/src/phase_thermal_externalheat.f90
+++ b/src/phase_thermal_externalheat.f90
@@ -92,7 +92,7 @@ module subroutine externalheat_dotState(ph, en)
so = source_thermal_externalheat_offset(ph)
- thermalState(ph)%p(so)%dotState(1,en) = 1.0_pReal ! state is current time
+ thermalState(ph)%p(so)%dotState(1,en) = 1.0_pREAL ! state is current time
end subroutine externalheat_dotState
@@ -105,7 +105,7 @@ module function externalheat_f_T(ph,en) result(f_T)
integer, intent(in) :: &
ph, &
en
- real(pReal) :: &
+ real(pREAL) :: &
f_T
integer :: &
diff --git a/src/polynomials.f90 b/src/polynomials.f90
index 2240616f7..062f99911 100644
--- a/src/polynomials.f90
+++ b/src/polynomials.f90
@@ -12,8 +12,8 @@ module polynomials
private
type, public :: tPolynomial
- real(pReal), dimension(:), allocatable :: coef
- real(pReal) :: x_ref = huge(0.0_pReal)
+ real(pREAL), dimension(:), allocatable :: coef
+ real(pREAL) :: x_ref = huge(0.0_pREAL)
contains
procedure, public :: at => eval
end type tPolynomial
@@ -47,8 +47,8 @@ end subroutine polynomials_init
!--------------------------------------------------------------------------------------------------
pure function polynomial_from_coef(coef,x_ref) result(p)
- real(pReal), dimension(0:), intent(in) :: coef
- real(pReal), intent(in) :: x_ref
+ real(pREAL), dimension(0:), intent(in) :: coef
+ real(pREAL), intent(in) :: x_ref
type(tPolynomial) :: p
@@ -67,23 +67,23 @@ function polynomial_from_dict(dict,y,x) result(p)
character(len=*), intent(in) :: y, x
type(tPolynomial) :: p
- real(pReal), dimension(:), allocatable :: coef
- real(pReal) :: x_ref
+ real(pREAL), dimension(:), allocatable :: coef
+ real(pREAL) :: x_ref
integer :: i, o
character(len=1) :: o_s
- allocate(coef(1),source=dict%get_asFloat(y))
+ allocate(coef(1),source=dict%get_asReal(y))
if (dict%contains(y//','//x)) then
- x_ref = dict%get_asFloat(x//'_ref')
- coef = [coef,dict%get_asFloat(y//','//x)]
+ x_ref = dict%get_asReal(x//'_ref')
+ coef = [coef,dict%get_asReal(y//','//x)]
end if
do o = 2,4
write(o_s,'(I0.0)') o
if (dict%contains(y//','//x//'^'//o_s)) then
- x_ref = dict%get_asFloat(x//'_ref')
- coef = [coef,[(0.0_pReal,i=size(coef),o-1)],dict%get_asFloat(y//','//x//'^'//o_s)]
+ x_ref = dict%get_asReal(x//'_ref')
+ coef = [coef,[(0.0_pREAL,i=size(coef),o-1)],dict%get_asReal(y//','//x//'^'//o_s)]
end if
end do
@@ -99,8 +99,8 @@ end function polynomial_from_dict
pure function eval(self,x) result(y)
class(tPolynomial), intent(in) :: self
- real(pReal), intent(in) :: x
- real(pReal) :: y
+ real(pREAL), intent(in) :: x
+ real(pREAL) :: y
integer :: o
@@ -123,21 +123,21 @@ end function eval
subroutine selfTest()
type(tPolynomial) :: p1, p2
- real(pReal), dimension(5) :: coef
+ real(pREAL), dimension(5) :: coef
integer :: i
- real(pReal) :: x_ref, x, y
+ real(pREAL) :: x_ref, x, y
type(tDict), pointer :: dict
- character(len=pStringLen), dimension(size(coef)) :: coef_s
- character(len=pStringLen) :: x_ref_s, x_s, YAML_s
+ character(len=pSTRLEN), dimension(size(coef)) :: coef_s
+ character(len=pSTRLEN) :: x_ref_s, x_s, YAML_s
call random_number(coef)
call random_number(x_ref)
call random_number(x)
- coef = coef*10_pReal -0.5_pReal
- x_ref = x_ref*10_pReal -0.5_pReal
- x = x*10_pReal -0.5_pReal
+ coef = coef*10_pREAL -0.5_pREAL
+ x_ref = x_ref*10_pREAL -0.5_pREAL
+ x = x*10_pREAL -0.5_pREAL
p1 = polynomial([coef(1)],x_ref)
if (dNeq(p1%at(x),coef(1))) error stop 'polynomial: eval(constant)'
@@ -158,37 +158,37 @@ subroutine selfTest()
'T_ref: '//trim(adjustl(x_ref_s))//IO_EOL
dict => YAML_parse_str_asDict(trim(YAML_s))
p2 = polynomial(dict,'C','T')
- if (dNeq(p1%at(x),p2%at(x),1.0e-6_pReal)) error stop 'polynomials: init'
+ if (dNeq(p1%at(x),p2%at(x),1.0e-6_pREAL)) error stop 'polynomials: init'
y = coef(1)+coef(2)*(x-x_ref)+coef(3)*(x-x_ref)**2+coef(4)*(x-x_ref)**3+coef(5)*(x-x_ref)**4
- if (dNeq(p1%at(x),y,1.0e-6_pReal)) error stop 'polynomials: eval(full)'
+ if (dNeq(p1%at(x),y,1.0e-6_pREAL)) error stop 'polynomials: eval(full)'
YAML_s = 'C: 0.0'//IO_EOL//&
'C,T: '//trim(adjustl(coef_s(2)))//IO_EOL//&
'T_ref: '//trim(adjustl(x_ref_s))//IO_EOL
dict => YAML_parse_str_asDict(trim(YAML_s))
p1 = polynomial(dict,'C','T')
- if (dNeq(p1%at(x_ref+x),-p1%at(x_ref-x),1.0e-10_pReal)) error stop 'polynomials: eval(linear)'
+ if (dNeq(p1%at(x_ref+x),-p1%at(x_ref-x),1.0e-10_pREAL)) error stop 'polynomials: eval(linear)'
YAML_s = 'C: 0.0'//IO_EOL//&
'C,T^2: '//trim(adjustl(coef_s(3)))//IO_EOL//&
'T_ref: '//trim(adjustl(x_ref_s))//IO_EOL
dict => YAML_parse_str_asDict(trim(YAML_s))
p1 = polynomial(dict,'C','T')
- if (dNeq(p1%at(x_ref+x),p1%at(x_ref-x),1e-10_pReal)) error stop 'polynomials: eval(quadratic)'
+ if (dNeq(p1%at(x_ref+x),p1%at(x_ref-x),1e-10_pREAL)) error stop 'polynomials: eval(quadratic)'
YAML_s = 'Y: '//trim(adjustl(coef_s(1)))//IO_EOL//&
'Y,X^3: '//trim(adjustl(coef_s(2)))//IO_EOL//&
'X_ref: '//trim(adjustl(x_ref_s))//IO_EOL
dict => YAML_parse_str_asDict(trim(YAML_s))
p1 = polynomial(dict,'Y','X')
- if (dNeq(p1%at(x_ref+x)-coef(1),-(p1%at(x_ref-x)-coef(1)),1.0e-8_pReal)) error stop 'polynomials: eval(cubic)'
+ if (dNeq(p1%at(x_ref+x)-coef(1),-(p1%at(x_ref-x)-coef(1)),1.0e-8_pREAL)) error stop 'polynomials: eval(cubic)'
YAML_s = 'Y: '//trim(adjustl(coef_s(1)))//IO_EOL//&
'Y,X^4: '//trim(adjustl(coef_s(2)))//IO_EOL//&
'X_ref: '//trim(adjustl(x_ref_s))//IO_EOL
dict => YAML_parse_str_asDict(trim(YAML_s))
p1 = polynomial(dict,'Y','X')
- if (dNeq(p1%at(x_ref+x),p1%at(x_ref-x),1.0e-6_pReal)) error stop 'polynomials: eval(quartic)'
+ if (dNeq(p1%at(x_ref+x),p1%at(x_ref-x),1.0e-6_pREAL)) error stop 'polynomials: eval(quartic)'
end subroutine selfTest
diff --git a/src/prec.f90 b/src/prec.f90
index a3ec72251..4f475a5aa 100644
--- a/src/prec.f90
+++ b/src/prec.f90
@@ -19,27 +19,27 @@ module prec
public
! https://stevelionel.com/drfortran/2017/03/27/doctor-fortran-in-it-takes-all-kinds
- integer, parameter :: pReal = IEEE_selected_real_kind(15,307) !< number with 15 significant digits, up to 1e+-307 (typically 64 bit)
+ integer, parameter :: pREAL = IEEE_selected_real_kind(15,307) !< number with 15 significant digits, up to 1e+-307 (typically 64 bit)
integer, parameter :: pI32 = selected_int_kind(9) !< number with at least up to +-1e9 (typically 32 bit)
integer, parameter :: pI64 = selected_int_kind(18) !< number with at least up to +-1e18 (typically 64 bit)
#ifdef PETSC
PetscInt, private :: dummy_int
integer, parameter :: pPETSCINT = kind(dummy_int)
PetscScalar, private :: dummy_scalar
- real(pReal), parameter, private :: pPETSCSCALAR = kind(dummy_scalar)
+ real(pREAL), parameter, private :: pPETSCSCALAR = kind(dummy_scalar)
#endif
- integer, parameter :: pSTRINGLEN = 256 !< default string length
+ integer, parameter :: pSTRLEN = 256 !< default string length
integer, parameter :: pPATHLEN = 4096 !< maximum length of a path name on linux
- real(pReal), parameter :: tol_math_check = 1.0e-8_pReal !< tolerance for internal math self-checks (rotation)
+ real(pREAL), parameter :: tol_math_check = 1.0e-8_pREAL !< tolerance for internal math self-checks (rotation)
- real(pReal), private, parameter :: PREAL_EPSILON = epsilon(0.0_pReal) !< minimum positive number such that 1.0 + EPSILON /= 1.0.
- real(pReal), private, parameter :: PREAL_MIN = tiny(0.0_pReal) !< smallest normalized floating point number
+ real(pREAL), private, parameter :: PREAL_EPSILON = epsilon(0.0_pREAL) !< minimum positive number such that 1.0 + EPSILON /= 1.0.
+ real(pREAL), private, parameter :: PREAL_MIN = tiny(0.0_pREAL) !< smallest normalized floating point number
- integer, dimension(0), parameter :: emptyIntArray = [integer::]
- real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::]
- character(len=pStringLen), dimension(0), parameter :: emptyStringArray = [character(len=pStringLen)::]
+ integer, dimension(0), parameter :: emptyIntArray = [integer::]
+ real(pREAL), dimension(0), parameter :: emptyRealArray = [real(pREAL)::]
+ character(len=pSTRLEN), dimension(0), parameter :: emptyStrArray = [character(len=pSTRLEN)::]
contains
@@ -52,13 +52,13 @@ subroutine prec_init()
print'(/,1x,a)', '<<<+- prec init -+>>>'
- print'(/,a,i3)', ' integer size / bit: ',bit_size(0)
- print'( a,i19)', ' maximum value: ',huge(0)
- print'(/,a,i3)', ' float size / bit: ',storage_size(0.0_pReal)
- print'( a,e10.3)', ' maximum value: ',huge(0.0_pReal)
- print'( a,e10.3)', ' minimum value: ',PREAL_MIN
- print'( a,e10.3)', ' epsilon value: ',PREAL_EPSILON
- print'( a,i3)', ' decimal precision: ',precision(0.0_pReal)
+ print'(/,a,i3)', ' integer size / bit: ',bit_size(0)
+ print'( a,i19)', ' maximum value: ',huge(0)
+ print'(/,a,i3)', ' real size / bit: ',storage_size(0.0_pREAL)
+ print'( a,e10.3)', ' maximum value: ',huge(0.0_pREAL)
+ print'( a,e10.3)', ' minimum value: ',PREAL_MIN
+ print'( a,e10.3)', ' epsilon value: ',PREAL_EPSILON
+ print'( a,i3)', ' decimal precision: ',precision(0.0_pREAL)
call prec_selfTest()
@@ -74,8 +74,8 @@ end subroutine prec_init
!--------------------------------------------------------------------------------------------------
logical elemental pure function dEq(a,b,tol)
- real(pReal), intent(in) :: a,b
- real(pReal), intent(in), optional :: tol
+ real(pREAL), intent(in) :: a,b
+ real(pREAL), intent(in), optional :: tol
if (present(tol)) then
@@ -95,8 +95,8 @@ end function dEq
!--------------------------------------------------------------------------------------------------
logical elemental pure function dNeq(a,b,tol)
- real(pReal), intent(in) :: a,b
- real(pReal), intent(in), optional :: tol
+ real(pREAL), intent(in) :: a,b
+ real(pREAL), intent(in), optional :: tol
dNeq = .not. dEq(a,b,tol)
@@ -112,14 +112,14 @@ end function dNeq
!--------------------------------------------------------------------------------------------------
logical elemental pure function dEq0(a,tol)
- real(pReal), intent(in) :: a
- real(pReal), intent(in), optional :: tol
+ real(pREAL), intent(in) :: a
+ real(pREAL), intent(in), optional :: tol
if (present(tol)) then
dEq0 = abs(a) <= tol
else
- dEq0 = abs(a) <= PREAL_MIN * 10.0_pReal
+ dEq0 = abs(a) <= PREAL_MIN * 10.0_pREAL
end if
end function dEq0
@@ -133,8 +133,8 @@ end function dEq0
!--------------------------------------------------------------------------------------------------
logical elemental pure function dNeq0(a,tol)
- real(pReal), intent(in) :: a
- real(pReal), intent(in), optional :: tol
+ real(pREAL), intent(in) :: a
+ real(pREAL), intent(in), optional :: tol
dNeq0 = .not. dEq0(a,tol)
@@ -151,8 +151,8 @@ end function dNeq0
!--------------------------------------------------------------------------------------------------
logical elemental pure function cEq(a,b,tol)
- complex(pReal), intent(in) :: a,b
- real(pReal), intent(in), optional :: tol
+ complex(pREAL), intent(in) :: a,b
+ real(pREAL), intent(in), optional :: tol
if (present(tol)) then
@@ -173,8 +173,8 @@ end function cEq
!--------------------------------------------------------------------------------------------------
logical elemental pure function cNeq(a,b,tol)
- complex(pReal), intent(in) :: a,b
- real(pReal), intent(in), optional :: tol
+ complex(pREAL), intent(in) :: a,b
+ real(pREAL), intent(in), optional :: tol
cNeq = .not. cEq(a,b,tol)
@@ -248,13 +248,13 @@ end function prec_bytesToC_INT64_T
subroutine prec_selfTest()
integer, allocatable, dimension(:) :: realloc_lhs_test
- real(pReal), dimension(1) :: f
+ real(pREAL), dimension(1) :: f
integer(pI64), dimension(1) :: i
- real(pReal), dimension(2) :: r
+ real(pREAL), dimension(2) :: r
#ifdef PETSC
- if (pReal /= pPETSCSCALAR) error stop 'PETSc and DAMASK scalar datatypes do not match'
+ if (pREAL /= pPETSCSCALAR) error stop 'PETSc and DAMASK scalar datatypes do not match'
#endif
realloc_lhs_test = [1,2]
if (any(realloc_lhs_test/=[1,2])) error stop 'LHS allocation'
@@ -267,11 +267,11 @@ subroutine prec_selfTest()
! https://www.binaryconvert.com
! https://www.rapidtables.com/convert/number/binary-to-decimal.html
- f = real(prec_bytesToC_FLOAT(int([-65,+11,-102,+75],C_SIGNED_CHAR)),pReal)
- if (dNeq(f(1),20191102.0_pReal,0.0_pReal)) error stop 'prec_bytesToC_FLOAT'
+ f = real(prec_bytesToC_FLOAT(int([-65,+11,-102,+75],C_SIGNED_CHAR)),pREAL)
+ if (dNeq(f(1),20191102.0_pREAL,0.0_pREAL)) error stop 'prec_bytesToC_FLOAT'
- f = real(prec_bytesToC_DOUBLE(int([0,0,0,-32,+119,+65,+115,65],C_SIGNED_CHAR)),pReal)
- if (dNeq(f(1),20191102.0_pReal,0.0_pReal)) error stop 'prec_bytesToC_DOUBLE'
+ f = real(prec_bytesToC_DOUBLE(int([0,0,0,-32,+119,+65,+115,65],C_SIGNED_CHAR)),pREAL)
+ if (dNeq(f(1),20191102.0_pREAL,0.0_pREAL)) error stop 'prec_bytesToC_DOUBLE'
i = int(prec_bytesToC_INT32_T(int([+126,+23,+52,+1],C_SIGNED_CHAR)),pI64)
if (i(1) /= 20191102_pI64) error stop 'prec_bytesToC_INT32_T'
diff --git a/src/result.f90 b/src/result.f90
index 0f29e9e53..b21429fa8 100644
--- a/src/result.f90
+++ b/src/result.f90
@@ -141,9 +141,9 @@ end subroutine result_closeJobFile
subroutine result_addIncrement(inc,time)
integer, intent(in) :: inc
- real(pReal), intent(in) :: time
+ real(pREAL), intent(in) :: time
- character(len=pStringLen) :: incChar
+ character(len=pSTRLEN) :: incChar
write(incChar,'(i10)') inc
@@ -251,7 +251,7 @@ end subroutine result_addAttribute_int
subroutine result_addAttribute_real(attrLabel,attrValue,path)
character(len=*), intent(in) :: attrLabel
- real(pReal), intent(in) :: attrValue
+ real(pREAL), intent(in) :: attrValue
character(len=*), intent(in), optional :: path
@@ -296,7 +296,7 @@ end subroutine result_addAttribute_int_array
subroutine result_addAttribute_real_array(attrLabel,attrValue,path)
character(len=*), intent(in) :: attrLabel
- real(pReal), intent(in), dimension(:) :: attrValue
+ real(pREAL), intent(in), dimension(:) :: attrValue
character(len=*), intent(in), optional :: path
@@ -345,7 +345,7 @@ subroutine result_writeScalarDataset_real(dataset,group,label,description,SIunit
character(len=*), intent(in) :: label,group,description
character(len=*), intent(in), optional :: SIunit
- real(pReal), intent(in), dimension(:) :: dataset
+ real(pREAL), intent(in), dimension(:) :: dataset
integer(HID_T) :: groupHandle
@@ -366,7 +366,7 @@ subroutine result_writeVectorDataset_real(dataset,group,label,description,SIunit
character(len=*), intent(in) :: label,group,description
character(len=*), intent(in), optional :: SIunit
character(len=*), intent(in), dimension(:), optional :: systems
- real(pReal), intent(in), dimension(:,:) :: dataset
+ real(pREAL), intent(in), dimension(:,:) :: dataset
integer(HID_T) :: groupHandle
@@ -390,11 +390,11 @@ subroutine result_writeTensorDataset_real(dataset,group,label,description,SIunit
character(len=*), intent(in) :: label,group,description
character(len=*), intent(in), optional :: SIunit
logical, intent(in), optional :: transposed
- real(pReal), intent(in), dimension(:,:,:) :: dataset
+ real(pREAL), intent(in), dimension(:,:,:) :: dataset
integer :: i
integer(HID_T) :: groupHandle
- real(pReal), dimension(:,:,:), allocatable :: dataset_transposed
+ real(pREAL), dimension(:,:,:), allocatable :: dataset_transposed
groupHandle = result_openGroup(group)
@@ -488,7 +488,7 @@ subroutine result_mapping_phase(ID,entry,label)
plist_id, &
dt_id
- integer(SIZE_T) :: type_size_string, type_size_int
+ integer(SIZE_T) :: type_size_str, type_size_int
integer :: hdferr, ce, co
integer(MPI_INTEGER_KIND) :: err_MPI
@@ -536,23 +536,23 @@ subroutine result_mapping_phase(ID,entry,label)
call HDF5_chkerr(hdferr)
call H5Tset_size_f(dt_id, int(len(label(1)),SIZE_T), hdferr)
call HDF5_chkerr(hdferr)
- call H5Tget_size_f(dt_id, type_size_string, hdferr)
+ call H5Tget_size_f(dt_id, type_size_str, hdferr)
call HDF5_chkerr(hdferr)
pI64_t = h5kind_to_type(kind(entryGlobal),H5_INTEGER_KIND)
call H5Tget_size_f(pI64_t, type_size_int, hdferr)
call HDF5_chkerr(hdferr)
- call H5Tcreate_f(H5T_COMPOUND_F, type_size_string + type_size_int, dtype_id, hdferr)
+ call H5Tcreate_f(H5T_COMPOUND_F, type_size_str + type_size_int, dtype_id, hdferr)
call HDF5_chkerr(hdferr)
call H5Tinsert_f(dtype_id, 'label', 0_SIZE_T, dt_id,hdferr)
call HDF5_chkerr(hdferr)
- call H5Tinsert_f(dtype_id, 'entry', type_size_string, pI64_t, hdferr)
+ call H5Tinsert_f(dtype_id, 'entry', type_size_str, pI64_t, hdferr)
call HDF5_chkerr(hdferr)
!--------------------------------------------------------------------------------------------------
! create memory types for each component of the compound type
- call H5Tcreate_f(H5T_COMPOUND_F, type_size_string, label_id, hdferr)
+ call H5Tcreate_f(H5T_COMPOUND_F, type_size_str, label_id, hdferr)
call HDF5_chkerr(hdferr)
call H5Tinsert_f(label_id, 'label', 0_SIZE_T, dt_id, hdferr)
call HDF5_chkerr(hdferr)
@@ -644,7 +644,7 @@ subroutine result_mapping_homogenization(ID,entry,label)
plist_id, &
dt_id
- integer(SIZE_T) :: type_size_string, type_size_int
+ integer(SIZE_T) :: type_size_str, type_size_int
integer :: hdferr, ce
integer(MPI_INTEGER_KIND) :: err_MPI
@@ -688,23 +688,23 @@ subroutine result_mapping_homogenization(ID,entry,label)
call HDF5_chkerr(hdferr)
call H5Tset_size_f(dt_id, int(len(label(1)),SIZE_T), hdferr)
call HDF5_chkerr(hdferr)
- call H5Tget_size_f(dt_id, type_size_string, hdferr)
+ call H5Tget_size_f(dt_id, type_size_str, hdferr)
call HDF5_chkerr(hdferr)
pI64_t = h5kind_to_type(kind(entryGlobal),H5_INTEGER_KIND)
call H5Tget_size_f(pI64_t, type_size_int, hdferr)
call HDF5_chkerr(hdferr)
- call H5Tcreate_f(H5T_COMPOUND_F, type_size_string + type_size_int, dtype_id, hdferr)
+ call H5Tcreate_f(H5T_COMPOUND_F, type_size_str + type_size_int, dtype_id, hdferr)
call HDF5_chkerr(hdferr)
call H5Tinsert_f(dtype_id, 'label', 0_SIZE_T, dt_id,hdferr)
call HDF5_chkerr(hdferr)
- call H5Tinsert_f(dtype_id, 'entry', type_size_string, pI64_t, hdferr)
+ call H5Tinsert_f(dtype_id, 'entry', type_size_str, pI64_t, hdferr)
call HDF5_chkerr(hdferr)
!--------------------------------------------------------------------------------------------------
! create memory types for each component of the compound type
- call H5Tcreate_f(H5T_COMPOUND_F, type_size_string, label_id, hdferr)
+ call H5Tcreate_f(H5T_COMPOUND_F, type_size_str, label_id, hdferr)
call HDF5_chkerr(hdferr)
call H5Tinsert_f(label_id, 'label', 0_SIZE_T, dt_id, hdferr)
call HDF5_chkerr(hdferr)
diff --git a/src/rotations.f90 b/src/rotations.f90
index 35fb30026..58aa87ee0 100644
--- a/src/rotations.f90
+++ b/src/rotations.f90
@@ -53,10 +53,10 @@ module rotations
implicit none(type,external)
private
- real(pReal), parameter :: P = -1.0_pReal !< parameter for orientation conversion.
+ real(pREAL), parameter :: P = -1.0_pREAL !< parameter for orientation conversion.
type, public :: tRotation
- real(pReal), dimension(4) :: q
+ real(pREAL), dimension(4) :: q
contains
procedure, public :: asQuaternion
procedure, public :: asEulers
@@ -79,16 +79,16 @@ module rotations
procedure, public :: standardize
end type tRotation
- real(pReal), parameter :: &
- PREF = sqrt(6.0_pReal/PI), &
- A = PI**(5.0_pReal/6.0_pReal)/6.0_pReal**(1.0_pReal/6.0_pReal), &
- AP = PI**(2.0_pReal/3.0_pReal), &
+ real(pREAL), parameter :: &
+ PREF = sqrt(6.0_pREAL/PI), &
+ A = PI**(5.0_pREAL/6.0_pREAL)/6.0_pREAL**(1.0_pREAL/6.0_pREAL), &
+ AP = PI**(2.0_pREAL/3.0_pREAL), &
SC = A/AP, &
- BETA = A/2.0_pReal, &
- R1 = (3.0_pReal*PI/4.0_pReal)**(1.0_pReal/3.0_pReal), &
- R2 = sqrt(2.0_pReal), &
- PI12 = PI/12.0_pReal, &
- PREK = R1 * 2.0_pReal**(1.0_pReal/4.0_pReal)/BETA
+ BETA = A/2.0_pREAL, &
+ R1 = (3.0_pREAL*PI/4.0_pREAL)**(1.0_pREAL/3.0_pREAL), &
+ R2 = sqrt(2.0_pREAL), &
+ PI12 = PI/12.0_pREAL, &
+ PREK = R1 * 2.0_pREAL**(1.0_pREAL/4.0_pREAL)/BETA
public :: &
rotations_init, &
@@ -117,7 +117,7 @@ end subroutine rotations_init
pure function asQuaternion(self)
class(tRotation), intent(in) :: self
- real(pReal), dimension(4) :: asQuaternion
+ real(pREAL), dimension(4) :: asQuaternion
asQuaternion = self%q
@@ -127,7 +127,7 @@ end function asQuaternion
pure function asEulers(self)
class(tRotation), intent(in) :: self
- real(pReal), dimension(3) :: asEulers
+ real(pREAL), dimension(3) :: asEulers
asEulers = qu2eu(self%q)
@@ -137,7 +137,7 @@ end function asEulers
pure function asAxisAngle(self)
class(tRotation), intent(in) :: self
- real(pReal), dimension(4) :: asAxisAngle
+ real(pREAL), dimension(4) :: asAxisAngle
asAxisAngle = qu2ax(self%q)
@@ -147,7 +147,7 @@ end function asAxisAngle
pure function asMatrix(self)
class(tRotation), intent(in) :: self
- real(pReal), dimension(3,3) :: asMatrix
+ real(pREAL), dimension(3,3) :: asMatrix
asMatrix = qu2om(self%q)
@@ -160,10 +160,10 @@ end function asMatrix
subroutine fromQuaternion(self,qu)
class(tRotation), intent(out) :: self
- real(pReal), dimension(4), intent(in) :: qu
+ real(pREAL), dimension(4), intent(in) :: qu
- if (dNeq(norm2(qu),1.0_pReal,1.0e-8_pReal)) call IO_error(402,ext_msg='fromQuaternion')
+ if (dNeq(norm2(qu),1.0_pREAL,1.0e-8_pREAL)) call IO_error(402,ext_msg='fromQuaternion')
self%q = qu
@@ -172,15 +172,15 @@ end subroutine fromQuaternion
subroutine fromEulers(self,eu,degrees)
class(tRotation), intent(out) :: self
- real(pReal), dimension(3), intent(in) :: eu
+ real(pREAL), dimension(3), intent(in) :: eu
logical, intent(in), optional :: degrees
- real(pReal), dimension(3) :: Eulers
+ real(pREAL), dimension(3) :: Eulers
Eulers = merge(eu*INRAD,eu,misc_optional(degrees,.false.))
- if (any(Eulers<0.0_pReal) .or. any(Eulers>TAU) .or. Eulers(2) > PI) &
+ if (any(Eulers<0.0_pREAL) .or. any(Eulers>TAU) .or. Eulers(2) > PI) &
call IO_error(402,ext_msg='fromEulers')
self%q = eu2qu(Eulers)
@@ -190,20 +190,20 @@ end subroutine fromEulers
subroutine fromAxisAngle(self,ax,degrees,P)
class(tRotation), intent(out) :: self
- real(pReal), dimension(4), intent(in) :: ax
+ real(pREAL), dimension(4), intent(in) :: ax
logical, intent(in), optional :: degrees
integer, intent(in), optional :: P
- real(pReal) :: angle
- real(pReal),dimension(3) :: axis
+ real(pREAL) :: angle
+ real(pREAL),dimension(3) :: axis
angle = merge(ax(4)*INRAD,ax(4),misc_optional(degrees,.false.))
- axis = ax(1:3) * merge(-1.0_pReal,1.0_pReal,misc_optional(P,-1) == 1)
+ 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) &
+ if (dNeq(norm2(axis),1.0_pREAL) .or. angle < 0.0_pREAL .or. angle > PI) &
call IO_error(402,ext_msg='fromAxisAngle')
self%q = ax2qu([axis,angle])
@@ -213,10 +213,10 @@ end subroutine fromAxisAngle
subroutine fromMatrix(self,om)
class(tRotation), intent(out) :: self
- real(pReal), dimension(3,3), intent(in) :: om
+ real(pREAL), dimension(3,3), intent(in) :: om
- if (dNeq(math_det33(om),1.0_pReal,tol=1.0e-5_pReal)) &
+ if (dNeq(math_det33(om),1.0_pREAL,tol=1.0e-5_pREAL)) &
call IO_error(402,ext_msg='fromMatrix')
self%q = om2qu(om)
@@ -248,7 +248,7 @@ pure elemental subroutine standardize(self)
class(tRotation), intent(inout) :: self
- if (sign(1.0_pReal,self%q(1)) < 0.0_pReal) self%q = - self%q
+ if (sign(1.0_pREAL,self%q(1)) < 0.0_pREAL) self%q = - self%q
end subroutine standardize
@@ -259,18 +259,18 @@ end subroutine standardize
!--------------------------------------------------------------------------------------------------
pure function rotVector(self,v,active) result(vRot)
- real(pReal), dimension(3) :: vRot
+ real(pREAL), dimension(3) :: vRot
class(tRotation), intent(in) :: self
- real(pReal), intent(in), dimension(3) :: v
+ real(pREAL), intent(in), dimension(3) :: v
logical, intent(in), optional :: active
- real(pReal), dimension(4) :: v_normed, q
+ real(pREAL), dimension(4) :: v_normed, q
if (dEq0(norm2(v))) then
vRot = v
else
- v_normed = [0.0_pReal,v]/norm2(v)
+ v_normed = [0.0_pREAL,v]/norm2(v)
q = merge(multiplyQuaternion(conjugateQuaternion(self%q), multiplyQuaternion(v_normed, self%q)), &
multiplyQuaternion(self%q, multiplyQuaternion(v_normed, conjugateQuaternion(self%q))), &
misc_optional(active,.false.))
@@ -287,9 +287,9 @@ end function rotVector
!--------------------------------------------------------------------------------------------------
pure function rotTensor2(self,T,active) result(tRot)
- real(pReal), dimension(3,3) :: tRot
+ real(pREAL), dimension(3,3) :: tRot
class(tRotation), intent(in) :: self
- real(pReal), intent(in), dimension(3,3) :: T
+ real(pREAL), intent(in), dimension(3,3) :: T
logical, intent(in), optional :: active
@@ -307,17 +307,17 @@ end function rotTensor2
!--------------------------------------------------------------------------------------------------
pure function rotTensor4(self,T,active) result(tRot)
- real(pReal), dimension(3,3,3,3) :: tRot
+ real(pREAL), dimension(3,3,3,3) :: tRot
class(tRotation), intent(in) :: self
- real(pReal), intent(in), dimension(3,3,3,3) :: T
+ real(pREAL), intent(in), dimension(3,3,3,3) :: T
logical, intent(in), optional :: active
- real(pReal), dimension(3,3) :: R
+ real(pREAL), dimension(3,3) :: R
integer :: i,j,k,l,m,n,o,p
R = merge(transpose(self%asMatrix()),self%asMatrix(),misc_optional(active,.false.))
- tRot = 0.0_pReal
+ tRot = 0.0_pREAL
do i = 1,3;do j = 1,3;do k = 1,3;do l = 1,3
do m = 1,3;do n = 1,3;do o = 1,3;do p = 1,3
tRot(i,j,k,l) = tRot(i,j,k,l) &
@@ -334,13 +334,13 @@ end function rotTensor4
!--------------------------------------------------------------------------------------------------
pure function rotStiffness(self,C,active) result(cRot)
- real(pReal), dimension(6,6) :: cRot
+ real(pREAL), dimension(6,6) :: cRot
class(tRotation), intent(in) :: self
- real(pReal), intent(in), dimension(6,6) :: C
+ real(pREAL), intent(in), dimension(6,6) :: C
logical, intent(in), optional :: active
- real(pReal), dimension(3,3) :: R
- real(pReal), dimension(6,6) :: M
+ real(pREAL), dimension(3,3) :: R
+ real(pREAL), dimension(6,6) :: M
R = merge(transpose(self%asMatrix()),self%asMatrix(),misc_optional(active,.false.))
@@ -351,11 +351,11 @@ pure function rotStiffness(self,C,active) result(cRot)
R(2,2)*R(3,2), R(1,2)*R(3,2), R(1,2)*R(2,2), &
R(1,3)**2, R(2,3)**2, R(3,3)**2, &
R(2,3)*R(3,3), R(1,3)*R(3,3), R(1,3)*R(2,3), &
- 2.0_pReal*R(1,2)*R(1,3), 2.0_pReal*R(2,2)*R(2,3), 2.0_pReal*R(3,2)*R(3,3), &
+ 2.0_pREAL*R(1,2)*R(1,3), 2.0_pREAL*R(2,2)*R(2,3), 2.0_pREAL*R(3,2)*R(3,3), &
R(2,2)*R(3,3)+R(2,3)*R(3,2), R(1,2)*R(3,3)+R(1,3)*R(3,2), R(1,2)*R(2,3)+R(1,3)*R(2,2), &
- 2.0_pReal*R(1,3)*R(1,1), 2.0_pReal*R(2,3)*R(2,1), 2.0_pReal*R(3,3)*R(3,1), &
+ 2.0_pREAL*R(1,3)*R(1,1), 2.0_pREAL*R(2,3)*R(2,1), 2.0_pREAL*R(3,3)*R(3,1), &
R(2,3)*R(3,1)+R(2,1)*R(3,3), R(1,3)*R(3,1)+R(1,1)*R(3,3), R(1,3)*R(2,1)+R(1,1)*R(2,3), &
- 2.0_pReal*R(1,1)*R(1,2), 2.0_pReal*R(2,1)*R(2,2), 2.0_pReal*R(3,1)*R(3,2), &
+ 2.0_pREAL*R(1,1)*R(1,2), 2.0_pREAL*R(2,1)*R(2,2), 2.0_pREAL*R(3,1)*R(3,2), &
R(2,1)*R(3,2)+R(2,2)*R(3,1), R(1,1)*R(3,2)+R(1,2)*R(3,1), R(1,1)*R(2,2)+R(1,2)*R(2,1)],[6,6])
cRot = matmul(M,matmul(C,transpose(M)))
@@ -383,27 +383,27 @@ end function misorientation
!--------------------------------------------------------------------------------------------------
pure function qu2om(qu) result(om)
- real(pReal), intent(in), dimension(4) :: qu
- real(pReal), dimension(3,3) :: om
+ real(pREAL), intent(in), dimension(4) :: qu
+ real(pREAL), dimension(3,3) :: om
- real(pReal) :: qq
+ real(pREAL) :: qq
qq = qu(1)**2-sum(qu(2:4)**2)
- om(1,1) = qq+2.0_pReal*qu(2)**2
- om(2,2) = qq+2.0_pReal*qu(3)**2
- om(3,3) = qq+2.0_pReal*qu(4)**2
+ om(1,1) = qq+2.0_pREAL*qu(2)**2
+ om(2,2) = qq+2.0_pREAL*qu(3)**2
+ om(3,3) = qq+2.0_pREAL*qu(4)**2
- om(1,2) = 2.0_pReal*(qu(2)*qu(3)-qu(1)*qu(4))
- om(2,3) = 2.0_pReal*(qu(3)*qu(4)-qu(1)*qu(2))
- om(3,1) = 2.0_pReal*(qu(4)*qu(2)-qu(1)*qu(3))
- om(2,1) = 2.0_pReal*(qu(3)*qu(2)+qu(1)*qu(4))
- om(3,2) = 2.0_pReal*(qu(4)*qu(3)+qu(1)*qu(2))
- om(1,3) = 2.0_pReal*(qu(2)*qu(4)+qu(1)*qu(3))
+ om(1,2) = 2.0_pREAL*(qu(2)*qu(3)-qu(1)*qu(4))
+ om(2,3) = 2.0_pREAL*(qu(3)*qu(4)-qu(1)*qu(2))
+ om(3,1) = 2.0_pREAL*(qu(4)*qu(2)-qu(1)*qu(3))
+ om(2,1) = 2.0_pREAL*(qu(3)*qu(2)+qu(1)*qu(4))
+ om(3,2) = 2.0_pREAL*(qu(4)*qu(3)+qu(1)*qu(2))
+ om(1,3) = 2.0_pREAL*(qu(2)*qu(4)+qu(1)*qu(3))
- if (sign(1.0_pReal,P) < 0.0_pReal) om = transpose(om)
- om = om/math_det33(om)**(1.0_pReal/3.0_pReal)
+ if (sign(1.0_pREAL,P) < 0.0_pREAL) om = transpose(om)
+ om = om/math_det33(om)**(1.0_pREAL/3.0_pREAL)
end function qu2om
@@ -414,10 +414,10 @@ end function qu2om
!--------------------------------------------------------------------------------------------------
pure function qu2eu(qu) result(eu)
- real(pReal), intent(in), dimension(4) :: qu
- real(pReal), dimension(3) :: eu
+ real(pREAL), intent(in), dimension(4) :: qu
+ real(pREAL), dimension(3) :: eu
- real(pReal) :: q12, q03, chi
+ real(pREAL) :: q12, q03, chi
q03 = qu(1)**2+qu(4)**2
@@ -425,15 +425,15 @@ pure function qu2eu(qu) result(eu)
chi = sqrt(q03*q12)
degenerated: if (dEq0(q12)) then
- eu = [atan2(-P*2.0_pReal*qu(1)*qu(4),qu(1)**2-qu(4)**2), 0.0_pReal, 0.0_pReal]
+ eu = [atan2(-P*2.0_pREAL*qu(1)*qu(4),qu(1)**2-qu(4)**2), 0.0_pREAL, 0.0_pREAL]
elseif (dEq0(q03)) then
- eu = [atan2( 2.0_pReal*qu(2)*qu(3),qu(2)**2-qu(3)**2), PI, 0.0_pReal]
+ eu = [atan2( 2.0_pREAL*qu(2)*qu(3),qu(2)**2-qu(3)**2), PI, 0.0_pREAL]
else degenerated
eu = [atan2((-P*qu(1)*qu(3)+qu(2)*qu(4))*chi, (-P*qu(1)*qu(2)-qu(3)*qu(4))*chi ), &
- atan2( 2.0_pReal*chi, q03-q12 ), &
+ atan2( 2.0_pREAL*chi, q03-q12 ), &
atan2(( P*qu(1)*qu(3)+qu(2)*qu(4))*chi, (-P*qu(1)*qu(2)+qu(3)*qu(4))*chi )]
end if degenerated
- where(sign(1.0_pReal,eu)<0.0_pReal) eu = mod(eu+TAU,[TAU,PI,TAU])
+ where(sign(1.0_pREAL,eu)<0.0_pREAL) eu = mod(eu+TAU,[TAU,PI,TAU])
end function qu2eu
@@ -444,17 +444,17 @@ end function qu2eu
!--------------------------------------------------------------------------------------------------
pure function qu2ax(qu) result(ax)
- real(pReal), intent(in), dimension(4) :: qu
- real(pReal), dimension(4) :: ax
+ real(pREAL), intent(in), dimension(4) :: qu
+ real(pREAL), dimension(4) :: ax
- real(pReal) :: omega, s
+ real(pREAL) :: omega, s
if (dEq0(sum(qu(2:4)**2))) then
- ax = [ 0.0_pReal, 0.0_pReal, 1.0_pReal, 0.0_pReal ] ! axis = [001]
+ ax = [ 0.0_pREAL, 0.0_pREAL, 1.0_pREAL, 0.0_pREAL ] ! axis = [001]
elseif (dNeq0(qu(1))) then
- s = sign(1.0_pReal,qu(1))/norm2(qu(2:4))
- omega = 2.0_pReal * acos(math_clip(qu(1),-1.0_pReal,1.0_pReal))
+ s = sign(1.0_pREAL,qu(1))/norm2(qu(2:4))
+ omega = 2.0_pREAL * acos(math_clip(qu(1),-1.0_pREAL,1.0_pREAL))
ax = [ qu(2)*s, qu(3)*s, qu(4)*s, omega ]
else
ax = [ qu(2), qu(3), qu(4), PI ]
@@ -470,29 +470,29 @@ end function qu2ax
!--------------------------------------------------------------------------------------------------
pure function om2qu(om) result(qu)
- real(pReal), intent(in), dimension(3,3) :: om
- real(pReal), dimension(4) :: qu
+ real(pREAL), intent(in), dimension(3,3) :: om
+ real(pREAL), dimension(4) :: qu
- real(pReal) :: trace,s
+ real(pREAL) :: trace,s
trace = math_trace33(om)
- if (trace > 0.0_pReal) then
- s = 0.5_pReal / sqrt(trace+1.0_pReal)
- qu = [0.25_pReal/s, (om(3,2)-om(2,3))*s,(om(1,3)-om(3,1))*s,(om(2,1)-om(1,2))*s]
+ if (trace > 0.0_pREAL) then
+ s = 0.5_pREAL / sqrt(trace+1.0_pREAL)
+ qu = [0.25_pREAL/s, (om(3,2)-om(2,3))*s,(om(1,3)-om(3,1))*s,(om(2,1)-om(1,2))*s]
else
if ( om(1,1) > om(2,2) .and. om(1,1) > om(3,3) ) then
- s = 2.0_pReal * sqrt( 1.0_pReal + om(1,1) - om(2,2) - om(3,3))
- qu = [ (om(3,2) - om(2,3)) /s,0.25_pReal * s,(om(1,2) + om(2,1)) / s,(om(1,3) + om(3,1)) / s]
+ s = 2.0_pREAL * sqrt( 1.0_pREAL + om(1,1) - om(2,2) - om(3,3))
+ qu = [ (om(3,2) - om(2,3)) /s,0.25_pREAL * s,(om(1,2) + om(2,1)) / s,(om(1,3) + om(3,1)) / s]
elseif (om(2,2) > om(3,3)) then
- s = 2.0_pReal * sqrt( 1.0_pReal + om(2,2) - om(1,1) - om(3,3))
- qu = [ (om(1,3) - om(3,1)) /s,(om(1,2) + om(2,1)) / s,0.25_pReal * s,(om(2,3) + om(3,2)) / s]
+ s = 2.0_pREAL * sqrt( 1.0_pREAL + om(2,2) - om(1,1) - om(3,3))
+ qu = [ (om(1,3) - om(3,1)) /s,(om(1,2) + om(2,1)) / s,0.25_pREAL * s,(om(2,3) + om(3,2)) / s]
else
- s = 2.0_pReal * sqrt( 1.0_pReal + om(3,3) - om(1,1) - om(2,2) )
- qu = [ (om(2,1) - om(1,2)) /s,(om(1,3) + om(3,1)) / s,(om(2,3) + om(3,2)) / s,0.25_pReal * s]
+ s = 2.0_pREAL * sqrt( 1.0_pREAL + om(3,3) - om(1,1) - om(2,2) )
+ qu = [ (om(2,1) - om(1,2)) /s,(om(1,3) + om(3,1)) / s,(om(2,3) + om(3,2)) / s,0.25_pREAL * s]
end if
end if
- if (sign(1.0_pReal,qu(1))<0.0_pReal) qu =-1.0_pReal * qu
+ if (sign(1.0_pREAL,qu(1))<0.0_pREAL) qu =-1.0_pREAL * qu
qu(2:4) = merge(qu(2:4),qu(2:4)*P,dEq0(qu(2:4)))
qu = qu/norm2(qu)
@@ -506,21 +506,21 @@ end function om2qu
!--------------------------------------------------------------------------------------------------
pure function om2eu(om) result(eu)
- real(pReal), intent(in), dimension(3,3) :: om
- real(pReal), dimension(3) :: eu
- real(pReal) :: zeta
+ real(pREAL), intent(in), dimension(3,3) :: om
+ real(pREAL), dimension(3) :: eu
+ real(pREAL) :: zeta
- if (dNeq(abs(om(3,3)),1.0_pReal,1.e-8_pReal)) then
- zeta = 1.0_pReal/sqrt(math_clip(1.0_pReal-om(3,3)**2,1e-64_pReal,1.0_pReal))
+ if (dNeq(abs(om(3,3)),1.0_pREAL,1.e-8_pREAL)) then
+ zeta = 1.0_pREAL/sqrt(math_clip(1.0_pREAL-om(3,3)**2,1e-64_pREAL,1.0_pREAL))
eu = [atan2(om(3,1)*zeta,-om(3,2)*zeta), &
- acos(math_clip(om(3,3),-1.0_pReal,1.0_pReal)), &
+ acos(math_clip(om(3,3),-1.0_pREAL,1.0_pREAL)), &
atan2(om(1,3)*zeta, om(2,3)*zeta)]
else
- eu = [atan2(om(1,2),om(1,1)), 0.5_pReal*PI*(1.0_pReal-om(3,3)),0.0_pReal ]
+ eu = [atan2(om(1,2),om(1,1)), 0.5_pREAL*PI*(1.0_pREAL-om(3,3)),0.0_pREAL ]
end if
- where(abs(eu) < 1.e-8_pReal) eu = 0.0_pReal
- where(sign(1.0_pReal,eu)<0.0_pReal) eu = mod(eu+TAU,[TAU,PI,TAU])
+ where(abs(eu) < 1.e-8_pREAL) eu = 0.0_pREAL
+ where(sign(1.0_pREAL,eu)<0.0_pREAL) eu = mod(eu+TAU,[TAU,PI,TAU])
end function om2eu
@@ -531,28 +531,28 @@ end function om2eu
!--------------------------------------------------------------------------------------------------
function om2ax(om) result(ax)
- real(pReal), intent(in), dimension(3,3) :: om
- real(pReal), dimension(4) :: ax
+ real(pREAL), intent(in), dimension(3,3) :: om
+ real(pREAL), dimension(4) :: ax
- real(pReal) :: t
- real(pReal), dimension(3) :: Wr, Wi
- real(pReal), dimension((64+2)*3) :: work
- real(pReal), dimension(3,3) :: VR, devNull, om_
+ real(pREAL) :: t
+ real(pREAL), dimension(3) :: Wr, Wi
+ real(pREAL), dimension((64+2)*3) :: work
+ real(pREAL), dimension(3,3) :: VR, devNull, om_
integer :: ierr, i
om_ = om
! first get the rotation angle
- t = 0.5_pReal * (math_trace33(om) - 1.0_pReal)
- ax(4) = acos(math_clip(t,-1.0_pReal,1.0_pReal))
+ t = 0.5_pREAL * (math_trace33(om) - 1.0_pREAL)
+ ax(4) = acos(math_clip(t,-1.0_pREAL,1.0_pREAL))
if (dEq0(ax(4))) then
- ax(1:3) = [ 0.0_pReal, 0.0_pReal, 1.0_pReal ]
+ ax(1:3) = [ 0.0_pREAL, 0.0_pREAL, 1.0_pREAL ]
else
call dgeev('N','V',3,om_,3,Wr,Wi,devNull,3,VR,3,work,size(work,1),ierr)
if (ierr /= 0) error stop 'LAPACK error'
- i = findloc(cEq(cmplx(Wr,Wi,pReal),cmplx(1.0_pReal,0.0_pReal,pReal),tol=1.0e-14_pReal),.true.,dim=1) !find eigenvalue (1,0)
+ i = findloc(cEq(cmplx(Wr,Wi,pREAL),cmplx(1.0_pREAL,0.0_pREAL,pREAL),tol=1.0e-14_pREAL),.true.,dim=1) !find eigenvalue (1,0)
if (i == 0) error stop 'om2ax conversion failed'
ax(1:3) = VR(1:3,i)
where ( dNeq0([om(2,3)-om(3,2), om(3,1)-om(1,3), om(1,2)-om(2,1)])) &
@@ -568,13 +568,13 @@ end function om2ax
!--------------------------------------------------------------------------------------------------
pure function eu2qu(eu) result(qu)
- real(pReal), intent(in), dimension(3) :: eu
- real(pReal), dimension(4) :: qu
- real(pReal), dimension(3) :: ee
- real(pReal) :: cPhi, sPhi
+ real(pREAL), intent(in), dimension(3) :: eu
+ real(pREAL), dimension(4) :: qu
+ real(pREAL), dimension(3) :: ee
+ real(pREAL) :: cPhi, sPhi
- ee = 0.5_pReal*eu
+ ee = 0.5_pREAL*eu
cPhi = cos(ee(2))
sPhi = sin(ee(2))
@@ -583,7 +583,7 @@ pure function eu2qu(eu) result(qu)
-P*sPhi*cos(ee(1)-ee(3)), &
-P*sPhi*sin(ee(1)-ee(3)), &
-P*cPhi*sin(ee(1)+ee(3))]
- if (sign(1.0_pReal,qu(1)) < 0.0_pReal) qu = qu * (-1.0_pReal)
+ if (sign(1.0_pREAL,qu(1)) < 0.0_pREAL) qu = qu * (-1.0_pREAL)
end function eu2qu
@@ -594,10 +594,10 @@ end function eu2qu
!--------------------------------------------------------------------------------------------------
pure function eu2om(eu) result(om)
- real(pReal), intent(in), dimension(3) :: eu
- real(pReal), dimension(3,3) :: om
+ real(pREAL), intent(in), dimension(3) :: eu
+ real(pREAL), dimension(3,3) :: om
- real(pReal), dimension(3) :: c, s
+ real(pREAL), dimension(3) :: c, s
c = cos(eu)
@@ -613,7 +613,7 @@ pure function eu2om(eu) result(om)
om(2,3) = c(3)*s(2)
om(3,3) = c(2)
- where(abs(om)<1.0e-12_pReal) om = 0.0_pReal
+ where(abs(om)<1.0e-12_pREAL) om = 0.0_pREAL
end function eu2om
@@ -624,25 +624,25 @@ end function eu2om
!--------------------------------------------------------------------------------------------------
pure function eu2ax(eu) result(ax)
- real(pReal), intent(in), dimension(3) :: eu
- real(pReal), dimension(4) :: ax
+ real(pREAL), intent(in), dimension(3) :: eu
+ real(pREAL), dimension(4) :: ax
- real(pReal) :: t, delta, tau, alpha, sigma
+ real(pREAL) :: t, delta, tau, alpha, sigma
- t = tan(eu(2)*0.5_pReal)
- sigma = 0.5_pReal*(eu(1)+eu(3))
- delta = 0.5_pReal*(eu(1)-eu(3))
+ t = tan(eu(2)*0.5_pREAL)
+ sigma = 0.5_pREAL*(eu(1)+eu(3))
+ delta = 0.5_pREAL*(eu(1)-eu(3))
tau = sqrt(t**2+sin(sigma)**2)
- alpha = merge(PI, 2.0_pReal*atan(tau/cos(sigma)), dEq(sigma,PI*0.5_pReal,tol=1.0e-15_pReal))
+ alpha = merge(PI, 2.0_pREAL*atan(tau/cos(sigma)), dEq(sigma,PI*0.5_pREAL,tol=1.0e-15_pREAL))
if (dEq0(alpha)) then ! return a default identity axis-angle pair
- ax = [ 0.0_pReal, 0.0_pReal, 1.0_pReal, 0.0_pReal ]
+ ax = [ 0.0_pREAL, 0.0_pREAL, 1.0_pREAL, 0.0_pREAL ]
else
ax(1:3) = -P/tau * [ t*cos(delta), t*sin(delta), sin(sigma) ] ! passive axis-angle pair so a minus sign in front
ax(4) = alpha
- if (sign(1.0_pReal,alpha) < 0.0_pReal) ax = -ax ! ensure alpha is positive
+ if (sign(1.0_pREAL,alpha) < 0.0_pREAL) ax = -ax ! ensure alpha is positive
end if
end function eu2ax
@@ -654,17 +654,17 @@ end function eu2ax
!--------------------------------------------------------------------------------------------------
pure function ax2qu(ax) result(qu)
- real(pReal), intent(in), dimension(4) :: ax
- real(pReal), dimension(4) :: qu
+ real(pREAL), intent(in), dimension(4) :: ax
+ real(pREAL), dimension(4) :: qu
- real(pReal) :: c, s
+ real(pREAL) :: c, s
if (dEq0(ax(4))) then
- qu = [ 1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal ]
+ qu = [ 1.0_pREAL, 0.0_pREAL, 0.0_pREAL, 0.0_pREAL ]
else
- c = cos(ax(4)*0.5_pReal)
- s = sin(ax(4)*0.5_pReal)
+ c = cos(ax(4)*0.5_pREAL)
+ s = sin(ax(4)*0.5_pREAL)
qu = [ c, ax(1)*s, ax(2)*s, ax(3)*s ]
end if
@@ -677,15 +677,15 @@ end function ax2qu
!--------------------------------------------------------------------------------------------------
pure function ax2om(ax) result(om)
- real(pReal), intent(in), dimension(4) :: ax
- real(pReal), dimension(3,3) :: om
+ real(pREAL), intent(in), dimension(4) :: ax
+ real(pREAL), dimension(3,3) :: om
- real(pReal) :: q, c, s, omc
+ real(pREAL) :: q, c, s, omc
c = cos(ax(4))
s = sin(ax(4))
- omc = 1.0_pReal-c
+ omc = 1.0_pREAL-c
om(1,1) = ax(1)**2*omc + c
om(2,2) = ax(2)**2*omc + c
@@ -703,7 +703,7 @@ pure function ax2om(ax) result(om)
om(3,1) = q + s*ax(2)
om(1,3) = q - s*ax(2)
- if (P > 0.0_pReal) om = transpose(om)
+ if (P > 0.0_pREAL) om = transpose(om)
end function ax2om
@@ -714,8 +714,8 @@ end function ax2om
!--------------------------------------------------------------------------------------------------
pure function ax2eu(ax) result(eu)
- real(pReal), intent(in), dimension(4) :: ax
- real(pReal), dimension(3) :: eu
+ real(pREAL), intent(in), dimension(4) :: ax
+ real(pREAL), dimension(3) :: eu
eu = om2eu(ax2om(ax))
@@ -728,8 +728,8 @@ end function ax2eu
!--------------------------------------------------------------------------------------------------
pure function multiplyQuaternion(qu1,qu2)
- real(pReal), dimension(4), intent(in) :: qu1, qu2
- real(pReal), dimension(4) :: multiplyQuaternion
+ real(pREAL), dimension(4), intent(in) :: qu1, qu2
+ real(pREAL), dimension(4) :: multiplyQuaternion
multiplyQuaternion(1) = qu1(1)*qu2(1) - qu1(2)*qu2(2) - qu1(3)*qu2(3) - qu1(4)*qu2(4)
@@ -745,8 +745,8 @@ end function multiplyQuaternion
!--------------------------------------------------------------------------------------------------
pure function conjugateQuaternion(qu)
- real(pReal), dimension(4), intent(in) :: qu
- real(pReal), dimension(4) :: conjugateQuaternion
+ real(pREAL), dimension(4), intent(in) :: qu
+ real(pREAL), dimension(4) :: conjugateQuaternion
conjugateQuaternion = [qu(1), -qu(2), -qu(3), -qu(4)]
@@ -760,36 +760,36 @@ end function conjugateQuaternion
subroutine selfTest()
type(tRotation) :: R
- real(pReal), dimension(4) :: qu
- real(pReal), dimension(3) :: x, eu, v3
- real(pReal), dimension(3,3) :: om, t33
- real(pReal), dimension(3,3,3,3) :: t3333
- real(pReal), dimension(6,6) :: C
- real(pReal) :: A,B
+ real(pREAL), dimension(4) :: qu
+ real(pREAL), dimension(3) :: x, eu, v3
+ real(pREAL), dimension(3,3) :: om, t33
+ real(pREAL), dimension(3,3,3,3) :: t3333
+ real(pREAL), dimension(6,6) :: C
+ real(pREAL) :: A,B
integer :: i
do i = 1, 20
if (i==1) then
- qu = [1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal]
+ qu = [1.0_pREAL, 0.0_pREAL, 0.0_pREAL, 0.0_pREAL]
elseif (i==2) then
- qu = [1.0_pReal,-0.0_pReal,-0.0_pReal,-0.0_pReal]
+ qu = [1.0_pREAL,-0.0_pREAL,-0.0_pREAL,-0.0_pREAL]
elseif (i==3) then
- qu = [0.0_pReal, 1.0_pReal, 0.0_pReal, 0.0_pReal]
+ qu = [0.0_pREAL, 1.0_pREAL, 0.0_pREAL, 0.0_pREAL]
elseif (i==4) then
- qu = [0.0_pReal,0.0_pReal,1.0_pReal,0.0_pReal]
+ qu = [0.0_pREAL,0.0_pREAL,1.0_pREAL,0.0_pREAL]
elseif (i==5) then
- qu = [0.0_pReal, 0.0_pReal, 0.0_pReal, 1.0_pReal]
+ qu = [0.0_pREAL, 0.0_pREAL, 0.0_pREAL, 1.0_pREAL]
else
call random_number(x)
A = sqrt(x(3))
- B = sqrt(1-0_pReal -x(3))
+ B = sqrt(1-0_pREAL -x(3))
qu = [cos(TAU*x(1))*A,&
sin(TAU*x(2))*B,&
cos(TAU*x(2))*B,&
sin(TAU*x(1))*A]
- if (qu(1)<0.0_pReal) qu = qu * (-1.0_pReal)
+ if (qu(1)<0.0_pREAL) qu = qu * (-1.0_pREAL)
end if
@@ -807,24 +807,24 @@ subroutine selfTest()
call R%fromMatrix(om)
call random_number(v3)
- if (any(dNeq(R%rotVector(R%rotVector(v3),active=.true.),v3,1.0e-12_pReal))) &
+ if (any(dNeq(R%rotVector(R%rotVector(v3),active=.true.),v3,1.0e-12_pREAL))) &
error stop 'rotVector'
call random_number(t33)
- if (any(dNeq(R%rotTensor2(R%rotTensor2(t33),active=.true.),t33,1.0e-12_pReal))) &
+ if (any(dNeq(R%rotTensor2(R%rotTensor2(t33),active=.true.),t33,1.0e-12_pREAL))) &
error stop 'rotTensor2'
call random_number(t3333)
- if (any(dNeq(R%rotTensor4(R%rotTensor4(t3333),active=.true.),t3333,1.0e-12_pReal))) &
+ if (any(dNeq(R%rotTensor4(R%rotTensor4(t3333),active=.true.),t3333,1.0e-12_pREAL))) &
error stop 'rotTensor4'
call random_number(C)
C = C+transpose(C)
if (any(dNeq(R%rotStiffness(C), &
- math_3333toVoigt66_stiffness(R%rotate(math_Voigt66to3333_stiffness(C))),1.0e-12_pReal))) &
+ math_3333toVoigt66_stiffness(R%rotate(math_Voigt66to3333_stiffness(C))),1.0e-12_pREAL))) &
error stop 'rotStiffness'
- call R%fromQuaternion(qu * (1.0_pReal + merge(+5.e-9_pReal,-5.e-9_pReal, mod(i,2) == 0))) ! allow reasonable tolerance for ASCII/YAML
+ call R%fromQuaternion(qu * (1.0_pREAL + merge(+5.e-9_pREAL,-5.e-9_pREAL, mod(i,2) == 0))) ! allow reasonable tolerance for ASCII/YAML
end do
@@ -832,12 +832,12 @@ subroutine selfTest()
pure recursive function quaternion_equal(qu1,qu2) result(ok)
- real(pReal), intent(in), dimension(4) :: qu1,qu2
+ real(pREAL), intent(in), dimension(4) :: qu1,qu2
logical :: ok
- ok = all(dEq(qu1,qu2,1.0e-7_pReal))
- if (dEq0(qu1(1),1.0e-12_pReal)) &
- ok = ok .or. all(dEq(-1.0_pReal*qu1,qu2,1.0e-7_pReal))
+ ok = all(dEq(qu1,qu2,1.0e-7_pREAL))
+ if (dEq0(qu1(1),1.0e-12_pREAL)) &
+ ok = ok .or. all(dEq(-1.0_pREAL*qu1,qu2,1.0e-7_pREAL))
end function quaternion_equal
diff --git a/src/system_routines.f90 b/src/system_routines.f90
index 0ac8eadd0..5207b5b94 100644
--- a/src/system_routines.f90
+++ b/src/system_routines.f90
@@ -47,8 +47,8 @@ module system_routines
use prec
implicit none(type,external)
- character(kind=C_CHAR), dimension(pStringLen+1), intent(out) :: hostname ! NULL-terminated array
- integer(C_INT), intent(out) :: stat
+ character(kind=C_CHAR), dimension(pSTRLEN+1), intent(out) :: hostname ! NULL-terminated array
+ integer(C_INT), intent(out) :: stat
end subroutine getHostName_C
subroutine getUserName_C(username, stat) bind(C)
@@ -56,8 +56,8 @@ module system_routines
use prec
implicit none(type,external)
- character(kind=C_CHAR), dimension(pStringLen+1), intent(out) :: username ! NULL-terminated array
- integer(C_INT), intent(out) :: stat
+ character(kind=C_CHAR), dimension(pSTRLEN+1), intent(out) :: username ! NULL-terminated array
+ integer(C_INT), intent(out) :: stat
end subroutine getUserName_C
subroutine signalint_C(handler) bind(C)
@@ -135,7 +135,7 @@ function getHostName()
character(len=:), allocatable :: getHostName
- character(kind=C_CHAR), dimension(pStringLen+1) :: getHostName_Cstring
+ character(kind=C_CHAR), dimension(pSTRLEN+1) :: getHostName_Cstring
integer(C_INT) :: stat
@@ -157,7 +157,7 @@ function getUserName()
character(len=:), allocatable :: getUserName
- character(kind=C_CHAR), dimension(pStringLen+1) :: getUserName_Cstring
+ character(kind=C_CHAR), dimension(pSTRLEN+1) :: getUserName_Cstring
integer(C_INT) :: stat
diff --git a/src/tables.f90 b/src/tables.f90
index c62082705..65bd7e514 100644
--- a/src/tables.f90
+++ b/src/tables.f90
@@ -13,7 +13,7 @@ module tables
private
type, public :: tTable
- real(pReal), dimension(:), allocatable :: x,y
+ real(pREAL), dimension(:), allocatable :: x,y
contains
procedure, public :: at => eval
end type tTable
@@ -47,7 +47,7 @@ end subroutine tables_init
!--------------------------------------------------------------------------------------------------
function table_from_values(x,y) result(t)
- real(pReal), dimension(:), intent(in) :: x,y
+ real(pREAL), dimension(:), intent(in) :: x,y
type(tTable) :: t
@@ -55,7 +55,7 @@ function table_from_values(x,y) result(t)
if (size(y) < 1) call IO_error(603,ext_msg='missing tabulated y data')
if (size(x) /= size(y)) call IO_error(603,ext_msg='shape mismatch in tabulated data')
if (size(x) /= 1) then
- if (any(x(2:size(x))-x(1:size(x)-1) <= 0.0_pReal)) &
+ if (any(x(2:size(x))-x(1:size(x)-1) <= 0.0_pREAL)) &
call IO_error(603,ext_msg='ordinate data does not increase monotonically')
end if
@@ -75,7 +75,7 @@ function table_from_dict(dict,x_label,y_label) result(t)
type(tTable) :: t
- t = tTable(dict%get_as1dFloat(x_label),dict%get_as1dFloat(y_label))
+ t = tTable(dict%get_as1dReal(x_label),dict%get_as1dReal(y_label))
end function table_from_dict
@@ -86,8 +86,8 @@ end function table_from_dict
pure function eval(self,x) result(y)
class(tTable), intent(in) :: self
- real(pReal), intent(in) :: x
- real(pReal) :: y
+ real(pREAL), intent(in) :: x
+ real(pREAL) :: y
integer :: i
@@ -109,25 +109,25 @@ end function eval
subroutine selfTest()
type(tTable) :: t
- real(pReal), dimension(*), parameter :: &
- x = real([ 1., 2., 3., 4.],pReal), &
- y = real([ 1., 3., 2.,-2.],pReal), &
- x_eval = real([ 0.0, 0.5, 1.0, 1.5, 2.0, 2.5, 3.0, 3.5, 4.0, 4.5, 5.0],pReal), &
- y_true = real([-1.0, 0.0, 1.0, 2.0, 3.0, 2.5 ,2.0, 0.0,-2.0,-4.0,-6.0],pReal)
+ real(pREAL), dimension(*), parameter :: &
+ x = real([ 1., 2., 3., 4.],pREAL), &
+ y = real([ 1., 3., 2.,-2.],pREAL), &
+ x_eval = real([ 0.0, 0.5, 1.0, 1.5, 2.0, 2.5, 3.0, 3.5, 4.0, 4.5, 5.0],pREAL), &
+ y_true = real([-1.0, 0.0, 1.0, 2.0, 3.0, 2.5 ,2.0, 0.0,-2.0,-4.0,-6.0],pREAL)
integer :: i
type(tDict), pointer :: dict
type(tList), pointer :: l_x, l_y
- real(pReal) :: r
+ real(pREAL) :: r
call random_number(r)
- t = table(real([0.],pReal),real([r],pReal))
- if (dNeq(r,t%at(r),1.0e-9_pReal)) error stop 'table eval/mono'
+ t = table(real([0.],pREAL),real([r],pREAL))
+ if (dNeq(r,t%at(r),1.0e-9_pREAL)) error stop 'table eval/mono'
- r = r-0.5_pReal
+ r = r-0.5_pREAL
t = table(x+r,y)
do i = 1, size(x_eval)
- if (dNeq(y_true(i),t%at(x_eval(i)+r),1.0e-9_pReal)) error stop 'table eval/values'
+ if (dNeq(y_true(i),t%at(x_eval(i)+r),1.0e-9_pREAL)) error stop 'table eval/values'
end do
l_x => YAML_parse_str_asList('[1, 2, 3, 4]'//IO_EOL)
diff --git a/src/test/test_HDF5_utilities.f90 b/src/test/test_HDF5_utilities.f90
index 815bbe671..94e4175ce 100644
--- a/src/test/test_HDF5_utilities.f90
+++ b/src/test/test_HDF5_utilities.f90
@@ -22,7 +22,7 @@ end subroutine HDF5_utilities_test
subroutine test_read_write()
integer(HID_T) :: f
- real(pReal), dimension(3) :: d_in,d_out
+ real(pREAL), dimension(3) :: d_in,d_out
call random_number(d_in)