From d0b832e6f184c178f126a2d91178a5f735d8d62b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 3 Jun 2023 17:06:32 +0200 Subject: [PATCH] consistent with naming in HDF5_utilities --- src/HDF5_utilities.f90 | 2 +- src/IO.f90 | 40 +++--- src/Marc/discretization_Marc.f90 | 8 +- src/YAML_types.f90 | 136 +++++++++--------- src/grid/DAMASK_grid.f90 | 8 +- src/grid/VTI.f90 | 4 +- src/grid/grid_damage_spectral.f90 | 6 +- src/grid/grid_mech_FEM.f90 | 12 +- src/grid/grid_mech_spectral_basic.f90 | 14 +- src/grid/grid_mech_spectral_polarisation.f90 | 22 +-- src/grid/grid_thermal_spectral.f90 | 6 +- src/grid/spectral_utilities.f90 | 2 +- src/homogenization_mechanical_RGC.f90 | 34 ++--- src/material.f90 | 6 +- src/mesh/DAMASK_mesh.f90 | 4 +- src/mesh/FEM_quadrature.f90 | 6 +- src/mesh/mesh_mech_FEM.f90 | 4 +- src/misc.f90 | 6 +- src/phase.f90 | 26 ++-- src/phase_damage.f90 | 4 +- src/phase_damage_anisobrittle.f90 | 10 +- src/phase_damage_isobrittle.f90 | 4 +- ...phase_mechanical_plastic_dislotungsten.f90 | 44 +++--- src/phase_mechanical_plastic_dislotwin.f90 | 88 ++++++------ src/phase_mechanical_plastic_isotropic.f90 | 28 ++-- ...phase_mechanical_plastic_kinehardening.f90 | 28 ++-- src/phase_mechanical_plastic_nonlocal.f90 | 76 +++++----- ...phase_mechanical_plastic_phenopowerlaw.f90 | 54 +++---- src/phase_thermal.f90 | 6 +- src/phase_thermal_dissipation.f90 | 2 +- src/polynomials.f90 | 10 +- src/prec.f90 | 14 +- src/tables.f90 | 2 +- 33 files changed, 358 insertions(+), 358 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index 936b224e8..c6af2facb 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 diff --git a/src/IO.f90 b/src/IO.f90 index 882b7faf6..315bc9fb5 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -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) diff --git a/src/Marc/discretization_Marc.f90 b/src/Marc/discretization_Marc.f90 index 46e9eba45..cdc7863ca 100644 --- a/src/Marc/discretization_Marc.f90 +++ b/src/Marc/discretization_Marc.f90 @@ -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) diff --git a/src/YAML_types.f90 b/src/YAML_types.f90 index a6ac9766d..201dd1da0 100644 --- a/src/YAML_types.f90 +++ b/src/YAML_types.f90 @@ -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 !-------------------------------------------------------------------------------------------------- diff --git a/src/grid/DAMASK_grid.f90 b/src/grid/DAMASK_grid.f90 index c77832346..84cd94e45 100644 --- a/src/grid/DAMASK_grid.f90 +++ b/src/grid/DAMASK_grid.f90 @@ -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 diff --git a/src/grid/VTI.f90 b/src/grid/VTI.f90 index cc5a6843b..ebc162ca9 100644 --- a/src/grid/VTI.f90 +++ b/src/grid/VTI.f90 @@ -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 diff --git a/src/grid/grid_damage_spectral.f90 b/src/grid/grid_damage_spectral.f90 index 0ba3c5a31..2c5ac0f16 100644 --- a/src/grid/grid_damage_spectral.f90 +++ b/src/grid/grid_damage_spectral.f90 @@ -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') diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index d55f58152..366504caa 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -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' diff --git a/src/grid/grid_mech_spectral_basic.f90 b/src/grid/grid_mech_spectral_basic.f90 index f2a009afb..6c423d51a 100644 --- a/src/grid/grid_mech_spectral_basic.f90 +++ b/src/grid/grid_mech_spectral_basic.f90 @@ -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' diff --git a/src/grid/grid_mech_spectral_polarisation.f90 b/src/grid/grid_mech_spectral_polarisation.f90 index 7bdd84d25..0b086508f 100644 --- a/src/grid/grid_mech_spectral_polarisation.f90 +++ b/src/grid/grid_mech_spectral_polarisation.f90 @@ -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' diff --git a/src/grid/grid_thermal_spectral.f90 b/src/grid/grid_thermal_spectral.f90 index 6483c91c6..e79a5d49e 100644 --- a/src/grid/grid_thermal_spectral.f90 +++ b/src/grid/grid_thermal_spectral.f90 @@ -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') diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 5821bd3c0..3a4b4c092 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -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) diff --git a/src/homogenization_mechanical_RGC.f90 b/src/homogenization_mechanical_RGC.f90 index 0e85fcca6..eff8a400e 100644 --- a/src/homogenization_mechanical_RGC.f90 +++ b/src/homogenization_mechanical_RGC.f90 @@ -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) & diff --git a/src/material.f90 b/src/material.f90 index 2169c876a..a2e2a90aa 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -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) diff --git a/src/mesh/DAMASK_mesh.f90 b/src/mesh/DAMASK_mesh.f90 index 29014e49f..a958e2f04 100644 --- a/src/mesh/DAMASK_mesh.f90 +++ b/src/mesh/DAMASK_mesh.f90 @@ -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 diff --git a/src/mesh/FEM_quadrature.f90 b/src/mesh/FEM_quadrature.f90 index 518cd1a4e..c54f998fa 100644 --- a/src/mesh/FEM_quadrature.f90 +++ b/src/mesh/FEM_quadrature.f90 @@ -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 diff --git a/src/mesh/mesh_mech_FEM.f90 b/src/mesh/mesh_mech_FEM.f90 index f612968fe..16fe24e19 100644 --- a/src/mesh/mesh_mech_FEM.f90 +++ b/src/mesh/mesh_mech_FEM.f90 @@ -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') diff --git a/src/misc.f90 b/src/misc.f90 index a56ea87c1..b3be4de14 100644 --- a/src/misc.f90 +++ b/src/misc.f90 @@ -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' diff --git a/src/phase.f90 b/src/phase.f90 index 11795f3d6..005d36660 100644 --- a/src/phase.f90 +++ b/src/phase.f90 @@ -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' diff --git a/src/phase_damage.f90 b/src/phase_damage.f90 index df5e00575..34565d308 100644 --- a/src/phase_damage.f90 +++ b/src/phase_damage.f90 @@ -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 diff --git a/src/phase_damage_anisobrittle.f90 b/src/phase_damage_anisobrittle.f90 index 69fa32564..427c4aa11 100644 --- a/src/phase_damage_anisobrittle.f90 +++ b/src/phase_damage_anisobrittle.f90 @@ -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 diff --git a/src/phase_damage_isobrittle.f90 b/src/phase_damage_isobrittle.f90 index 62a2eb7ec..569cb3cbb 100644 --- a/src/phase_damage_isobrittle.f90 +++ b/src/phase_damage_isobrittle.f90 @@ -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,:) diff --git a/src/phase_mechanical_plastic_dislotungsten.f90 b/src/phase_mechanical_plastic_dislotungsten.f90 index e37511967..ff949a51e 100644 --- a/src/phase_mechanical_plastic_dislotungsten.f90 +++ b/src/phase_mechanical_plastic_dislotungsten.f90 @@ -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) diff --git a/src/phase_mechanical_plastic_dislotwin.f90 b/src/phase_mechanical_plastic_dislotwin.f90 index ee6ccb9d1..7bdeb09fb 100644 --- a/src/phase_mechanical_plastic_dislotwin.f90 +++ b/src/phase_mechanical_plastic_dislotwin.f90 @@ -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) diff --git a/src/phase_mechanical_plastic_isotropic.f90 b/src/phase_mechanical_plastic_isotropic.f90 index 7a94e6d8b..39c95c6b8 100644 --- a/src/phase_mechanical_plastic_isotropic.f90 +++ b/src/phase_mechanical_plastic_isotropic.f90 @@ -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 diff --git a/src/phase_mechanical_plastic_kinehardening.f90 b/src/phase_mechanical_plastic_kinehardening.f90 index 390d5c7c8..5268d0bb9 100644 --- a/src/phase_mechanical_plastic_kinehardening.f90 +++ b/src/phase_mechanical_plastic_kinehardening.f90 @@ -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 diff --git a/src/phase_mechanical_plastic_nonlocal.f90 b/src/phase_mechanical_plastic_nonlocal.f90 index aeb647eeb..eca1aa7e5 100644 --- a/src/phase_mechanical_plastic_nonlocal.f90 +++ b/src/phase_mechanical_plastic_nonlocal.f90 @@ -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' diff --git a/src/phase_mechanical_plastic_phenopowerlaw.f90 b/src/phase_mechanical_plastic_phenopowerlaw.f90 index 11556db78..59b75df87 100644 --- a/src/phase_mechanical_plastic_phenopowerlaw.f90 +++ b/src/phase_mechanical_plastic_phenopowerlaw.f90 @@ -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 diff --git a/src/phase_thermal.f90 b/src/phase_thermal.f90 index 1371f3b7f..878d2c9ae 100644 --- a/src/phase_thermal.f90 +++ b/src/phase_thermal.f90 @@ -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__) diff --git a/src/phase_thermal_dissipation.f90 b/src/phase_thermal_dissipation.f90 index 66bde6808..74d7cd46f 100644 --- a/src/phase_thermal_dissipation.f90 +++ b/src/phase_thermal_dissipation.f90 @@ -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) diff --git a/src/polynomials.f90 b/src/polynomials.f90 index 2240616f7..1e1f2b842 100644 --- a/src/polynomials.f90 +++ b/src/polynomials.f90 @@ -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 diff --git a/src/prec.f90 b/src/prec.f90 index a3ec72251..ccf6dc9f9 100644 --- a/src/prec.f90 +++ b/src/prec.f90 @@ -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() diff --git a/src/tables.f90 b/src/tables.f90 index c62082705..b4e63e303 100644 --- a/src/tables.f90 +++ b/src/tables.f90 @@ -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