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

consistent with naming in HDF5_utilities

This commit is contained in:
Martin Diehl 2023-06-03 17:06:32 +02:00
parent a5a391688e
commit d0b832e6f1
33 changed files with 358 additions and 358 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/HDF5_utilities.f90
View File

@ -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

40
src/IO.f90
View File

@ -35,12 +35,12 @@ module IO
IO_stringPos, &
IO_stringValue, &
IO_intValue, &
IO_floatValue, &
IO_realValue, &
IO_lc, &
IO_rmComment, &
IO_intAsString, &
IO_stringAsInt, &
IO_stringAsFloat, &
IO_stringAsReal, &
IO_stringAsBool, &
IO_error, &
IO_warning, &
@ -272,17 +272,17 @@ 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(string,chunkPos,myChunk)
character(len=*), intent(in) :: string !< 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_stringAsReal(IO_stringValue(string,chunkPos,myChunk))
end function IO_floatValue
end function IO_realValue
!--------------------------------------------------------------------------------------------------
@ -371,25 +371,25 @@ end function IO_stringAsInt
!--------------------------------------------------------------------------------------------------
!> @brief Return float value from given string.
!> @brief Return real value from given string.
!--------------------------------------------------------------------------------------------------
real(pReal) function IO_stringAsFloat(string)
real(pReal) function IO_stringAsReal(string)
character(len=*), intent(in) :: string !< string for conversion to float value
character(len=*), intent(in) :: string !< 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
read(string,*,iostat=readStatus) IO_stringAsReal
if (readStatus /= 0) call IO_error(112,string)
else valid
IO_stringAsFloat = 0.0_pReal
IO_stringAsReal = 0.0_pReal
call IO_error(112,string)
end if valid
end function IO_stringAsFloat
end function IO_stringAsReal
!--------------------------------------------------------------------------------------------------
@ -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)
@ -733,12 +733,12 @@ 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_stringAsReal('1.0'))) error stop 'IO_stringAsReal'
if (dNeq(1.0_pReal, IO_stringAsReal('1e0'))) error stop 'IO_stringAsReal'
if (dNeq(0.1_pReal, IO_stringAsReal('1e-1'))) error stop 'IO_stringAsReal'
if (dNeq(0.1_pReal, IO_stringAsReal('1.0e-1'))) error stop 'IO_stringAsReal'
if (dNeq(0.1_pReal, IO_stringAsReal('1.00e-1'))) error stop 'IO_stringAsReal'
if (dNeq(10._pReal, IO_stringAsReal(' 1.0e+1 '))) error stop 'IO_stringAsReal'
if (3112019 /= IO_stringAsInt( '3112019')) error stop 'IO_stringAsInt'
if (3112019 /= IO_stringAsInt(' 3112019')) error stop 'IO_stringAsInt'
@ -760,7 +760,7 @@ subroutine selfTest()
str = ' 1.0 xxx'
chunkPos = IO_stringPos(str)
if (dNeq(1.0_pReal,IO_floatValue(str,chunkPos,1))) error stop 'IO_floatValue'
if (dNeq(1.0_pReal,IO_realValue(str,chunkPos,1))) error stop 'IO_realValue'
str = 'M 3112019 F'
chunkPos = IO_stringPos(str)

8
src/Marc/discretization_Marc.f90
View File

@ -75,7 +75,7 @@ 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
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)
@ -552,7 +552,7 @@ subroutine inputRead_elemNodes(nodes, &
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
@ -735,8 +735,8 @@ subroutine inputRead_material(materialAt,&
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))
do while (scan(IO_stringValue(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)

136
src/YAML_types.f90
View File

@ -32,10 +32,10 @@ module YAML_types
contains
procedure :: &
asFormattedString => tScalar_asFormattedString, &
asFloat => tScalar_asFloat, &
asInt => tScalar_asInt, &
asBool => tScalar_asBool, &
asString => tScalar_asString
asReal => tScalar_asReal, &
asInt => tScalar_asInt, &
asBool => tScalar_asBool, &
asString => tScalar_asString
end type tScalar
type, extends(tNode), public :: tList
@ -46,8 +46,8 @@ module YAML_types
procedure :: &
asFormattedString => tList_asFormattedString, &
append => tList_append, &
as1dFloat => tList_as1dFloat, &
as2dFloat => tList_as2dFloat, &
as1dReal => tList_as1dReal, &
as2dReal => tList_as2dReal, &
as1dInt => tList_as1dInt, &
as1dBool => tList_as1dBool, &
as1dString => tList_as1dString, &
@ -56,8 +56,8 @@ module YAML_types
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, &
@ -68,8 +68,8 @@ module YAML_types
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_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
@ -92,9 +92,9 @@ module YAML_types
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, &
@ -105,9 +105,9 @@ module YAML_types
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_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
@ -183,7 +183,7 @@ subroutine selfTest()
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 (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)'
@ -209,11 +209,11 @@ subroutine selfTest()
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 (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_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 (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'
@ -253,7 +253,7 @@ subroutine selfTest()
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 (dNeq(d%get_asReal('three'),3.0_pReal)) error stop 'tDict_get_asReal'
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'
call d%set('one-two',s4)
@ -371,17 +371,17 @@ 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_stringAsReal(self%value)
end function tScalar_asFloat
end function tScalar_asReal
!--------------------------------------------------------------------------------------------------
@ -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
!--------------------------------------------------------------------------------------------------
@ -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
!--------------------------------------------------------------------------------------------------
@ -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) :: 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
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
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
!--------------------------------------------------------------------------------------------------

8
src/grid/DAMASK_grid.f90
View File

@ -234,14 +234,14 @@ 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
@ -526,7 +526,7 @@ subroutine getMaskedTensor(values,mask,tensor)
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)
if (.not. mask(i,j)) values(i,j) = row%get_asReal(j)
end do
end do

4
src/grid/VTI.f90
View File

@ -216,11 +216,11 @@ subroutine cellsSizeOrigin(c,s,o,header)
c = [(IO_intValue(temp,IO_stringPos(temp),i),i=2,6,2)]
temp = getXMLValue(header,'Spacing')
delta = [(IO_floatValue(temp,IO_stringPos(temp),i),i=1,3)]
delta = [(IO_realValue(temp,IO_stringPos(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_stringPos(temp),i),i=1,3)]
end subroutine cellsSizeOrigin

6
src/grid/grid_damage_spectral.f90
View File

@ -98,11 +98,11 @@ 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%itmax <= 1) call IO_error(301,ext_msg='itmax')

12
src/grid/grid_mech_FEM.f90
View File

@ -129,12 +129,12 @@ 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'

14
src/grid/grid_mech_spectral_basic.f90
View File

@ -131,13 +131,13 @@ 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'

22
src/grid/grid_mech_spectral_polarisation.f90
View File

@ -142,17 +142,17 @@ 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'

6
src/grid/grid_thermal_spectral.f90
View File

@ -92,9 +92,9 @@ 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')

2
src/grid/spectral_utilities.f90
View File

@ -226,7 +226,7 @@ subroutine spectral_utilities_init()
!--------------------------------------------------------------------------------------------------
! 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))
call fftw_set_timelimit(num_grid%get_asReal('fftw_timelimit',defaultVal=300.0_pReal))
print'(/,1x,a)', 'FFTW initialized'; flush(IO_STDOUT)

34
src/homogenization_mechanical_RGC.f90
View File

@ -108,19 +108,19 @@ 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')
@ -156,11 +156,11 @@ module subroutine RGC_init()
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) &

6
src/material.f90
View File

@ -149,11 +149,11 @@ subroutine parse()
do co = 1, constituents%length
constituent => constituents%get_dict(co)
v_of(ma,co) = constituent%get_asFloat('v')
v_of(ma,co) = constituent%get_asReal('v')
ph_of(ma,co) = phases%index(constituent%get_asString('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)

4
src/mesh/DAMASK_mesh.f90
View File

@ -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')
@ -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

6
src/mesh/FEM_quadrature.f90
View File

@ -20,13 +20,13 @@ module FEM_quadrature
-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
type :: group_real !< variable length datatype
real(pReal), dimension(:), allocatable :: p
end type group_float
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

4
src/mesh/mesh_mech_FEM.f90
View File

@ -137,8 +137,8 @@ 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')

6
src/misc.f90
View File

@ -125,9 +125,9 @@ subroutine misc_selfTest()
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 (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'

26
src/phase.f90
View File

@ -402,8 +402,8 @@ subroutine phase_init
if (all(phase_lattice(ph) /= ['cF','cI','hP','tI'])) &
call IO_error(130,ext_msg='phase_init: '//phase%get_asString('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
@ -538,17 +538,17 @@ 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'

4
src/phase_damage.f90
View File

@ -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

10
src/phase_damage_anisobrittle.f90
View File

@ -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))
@ -97,7 +97,7 @@ module function anisobrittle_init() result(mySources)
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)
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

4
src/phase_damage_isobrittle.f90
View File

@ -64,7 +64,7 @@ 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)
@ -81,7 +81,7 @@ module function isobrittle_init() result(mySources)
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)
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,:)

44
src/phase_mechanical_plastic_dislotungsten.f90
View File

@ -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,7 +200,7 @@ 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'
@ -239,7 +239,7 @@ 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)
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
@ -247,13 +247,13 @@ module function plastic_dislotungsten_init() result(myPlasticity)
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)
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)

88
src/phase_mechanical_plastic_dislotwin.f90
View File

@ -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,26 +210,26 @@ 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) &
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
@ -243,7 +243,7 @@ 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'
@ -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))
@ -304,25 +304,25 @@ 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')
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_asFloat('c/a_hP')
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_asFloat('V_mol')
prm%h_tr_tr = lattice_interaction_TransByTrans(prm%N_tr,pl%get_as1dFloat('h_tr-tr'),&
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
@ -339,12 +339,12 @@ module function plastic_dislotwin_init() result(myPlasticity)
!--------------------------------------------------------------------------------------------------
! shearband related parameters
prm%gamma_0_sb = pl%get_asFloat('gamma_0_sb',defaultVal=0.0_pReal)
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_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%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'
@ -356,11 +356,11 @@ module function plastic_dislotwin_init() result(myPlasticity)
!--------------------------------------------------------------------------------------------------
! 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')
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
@ -369,13 +369,13 @@ module function plastic_dislotwin_init() result(myPlasticity)
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,7 +402,7 @@ 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)
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
@ -410,27 +410,27 @@ module function plastic_dislotwin_init() result(myPlasticity)
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)
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)
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)
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)

28
src/phase_mechanical_plastic_isotropic.f90
View File

@ -98,19 +98,19 @@ module function plastic_isotropic_init() result(myPlasticity)
prm%output = pl%get_as1dString('output',defaultVal=emptyStringArray)
#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.)
@ -135,7 +135,7 @@ 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)
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

28
src/phase_mechanical_plastic_kinehardening.f90
View File

@ -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)
@ -208,20 +208,20 @@ 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)
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)
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

76
src/phase_mechanical_plastic_nonlocal.f90
View File

@ -248,7 +248,7 @@ module function plastic_nonlocal_init() result(myPlasticity)
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%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,65 +288,65 @@ 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?
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.)
@ -491,7 +491,7 @@ 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)
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'

54
src/phase_mechanical_plastic_phenopowerlaw.f90
View File

@ -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), &
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)
@ -187,20 +187,20 @@ 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)
@ -218,10 +218,10 @@ 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
@ -246,7 +246,7 @@ 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)
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
@ -254,20 +254,20 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
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)
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

6
src/phase_thermal.f90
View File

@ -109,9 +109,9 @@ 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__)

2
src/phase_thermal_dissipation.f90
View File

@ -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)

10
src/polynomials.f90
View File

@ -73,17 +73,17 @@ function polynomial_from_dict(dict,y,x) result(p)
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

14
src/prec.f90
View File

@ -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()

2
src/tables.f90
View File

@ -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